diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/elabd.lst gcc-3.4.0/gcc/testsuite/ada/acats/elabd.lst *** gcc-3.3.3/gcc/testsuite/ada/acats/elabd.lst 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/elabd.lst 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,5 ---- + c731001 + c854002 + ca11018 + ca11019 + ca5006a diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/norun.lst gcc-3.4.0/gcc/testsuite/ada/acats/norun.lst *** gcc-3.3.3/gcc/testsuite/ada/acats/norun.lst 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/norun.lst 2003-10-29 17:04:38.000000000 +0000 *************** *** 0 **** --- 1,4 ---- + cdd2a03 + templat + # Tests must be sorted in alphabetical order + # cdd2a03: new Ada ruling not supported yet. diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/overflow.lst gcc-3.4.0/gcc/testsuite/ada/acats/overflow.lst *** gcc-3.3.3/gcc/testsuite/ada/acats/overflow.lst 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/overflow.lst 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,16 ---- + c45632a + c45632b + c45632c + c45504a + c45504b + c45504c + c45613a + c45613b + c45613c + c45304a + c45304b + c45304c + c46014a + c460008 + c460011 + c4a012b diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/run_acats gcc-3.4.0/gcc/testsuite/ada/acats/run_acats *** gcc-3.3.3/gcc/testsuite/ada/acats/run_acats 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/run_acats 2004-01-08 15:19:36.000000000 +0000 *************** *** 0 **** --- 1,54 ---- + #!/bin/sh + + if [ "$testdir" = "" ]; then + echo You must use make check or make check-ada + exit 1 + fi + + # Set up environment to use the Ada compiler from the object tree + + host_gnatchop=`type gnatchop | awk '{print $3}'` + host_gnatmake=`type gnatmake | awk '{print $3}'` + ROOT=`${PWDCMD-pwd}` + BASE=`cd $ROOT/../../..; ${PWDCMD-pwd}` + + PATH=$BASE:$ROOT:$PATH + ADA_INCLUDE_PATH=$BASE/ada/rts + ADA_OBJECTS_PATH=$ADA_INCLUDE_PATH + + if [ ! -d $ADA_INCLUDE_PATH ]; then + echo gnatlib missing, exiting. + exit 1 + fi + + if [ ! -f $BASE/gnatchop ]; then + echo gnattools missing, exiting. + exit 1 + fi + + if [ ! -f $BASE/gnatmake ]; then + echo gnattools missing, exiting. + exit 1 + fi + + GCC_DRIVER="$BASE/xgcc" + GCC="$BASE/xgcc -B$BASE/" + export PATH ADA_INCLUDE_PATH ADA_OBJECTS_PATH GCC_DRIVER GCC + + echo '#!/bin/sh' > host_gnatchop + echo PATH=`dirname $host_gnatchop`:'$PATH' >> host_gnatchop + echo unset ADA_INCLUDE_PATH ADA_OBJECTS_PATH GCC_EXEC_PREFIX >> host_gnatchop + echo export PATH >> host_gnatchop + echo exec $host_gnatchop '"$@"' >> host_gnatchop + + chmod +x host_gnatchop + + echo '#!/bin/sh' > host_gnatmake + echo PATH=`dirname $host_gnatmake`:'$PATH' >> host_gnatmake + echo unset ADA_INCLUDE_PATH ADA_OBJECTS_PATH GCC_EXEC_PREFIX >> host_gnatmake + echo export PATH >> host_gnatmake + echo exec $host_gnatmake '"$@"' >> host_gnatmake + + chmod +x host_gnatmake + + exec $testdir/run_all.sh "$@" diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/run_all.sh gcc-3.4.0/gcc/testsuite/ada/acats/run_all.sh *** gcc-3.3.3/gcc/testsuite/ada/acats/run_all.sh 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/run_all.sh 2004-01-13 11:48:46.000000000 +0000 *************** *** 0 **** --- 1,269 ---- + #!/bin/sh + # Run ACATS with the GNU Ada compiler + + # The following functions are to be customized if you run in cross + # environment or want to change compilation flags. Note that for + # tests requiring checks not turned on by default, this script + # automatically adds the needed flags to pass (ie: -gnato or -gnatE). + + # gccflags="-O3 -fomit-frame-pointer -funroll-all-loops -finline-functions" + # gnatflags="-gnatN" + + gccflags="" + gnatflags="-gnatws" + + target_run () { + $* + } + + # End of customization section. + + display_noeol () { + printf "$@" + printf "$@" >> $dir/acats.sum + printf "$@" >> $dir/acats.log + } + + display () { + echo "$@" + echo "$@" >> $dir/acats.sum + echo "$@" >> $dir/acats.log + } + + log () { + echo "$@" >> $dir/acats.sum + echo "$@" >> $dir/acats.log + } + + dir=`${PWDCMD-pwd}` + + if [ "$testdir" = "" ]; then + echo You must use make check or make check-ada + exit 1 + fi + + if [ "$dir" = "$testdir" ]; then + echo "error: srcdir must be different than objdir, exiting." + exit 1 + fi + + target_gnatchop () { + gnatchop --GCC="$GCC_DRIVER" $* + } + + target_gnatmake () { + echo gnatmake --GCC=\"$GCC\" $gnatflags $gccflags $* -largs $EXTERNAL_OBJECTS --GCC=\"$GCC\" + gnatmake --GCC="$GCC" $gnatflags $gccflags $* -largs $EXTERNAL_OBJECTS --GCC="$GCC" + } + + target_gcc () { + $GCC $gccflags $* + } + + clean_dir () { + rm -f "$binmain" *.o *.ali > /dev/null 2>&1 + } + + EXTERNAL_OBJECTS="" + # Global variable to communicate external objects to link with. + + rm -f $dir/acats.sum $dir/acats.log + + display " === acats configuration ===" + + display target gcc is $GCC + display `$GCC -v 2>&1` + display host=`gcc -dumpmachine` + display target=`$GCC -dumpmachine` + display `type gnatmake` + gnatls -v >> $dir/acats.log + display "" + + display " === acats support ===" + display_noeol "Generating support files..." + + rm -rf $dir/support + mkdir -p $dir/support + cd $dir/support + + cp $testdir/support/*.ada $testdir/support/*.a $testdir/support/*.tst $dir/support + + sed -e "s,ACATS4GNATDIR,$dir,g" \ + < $testdir/support/impdef.a > $dir/support/impdef.a + sed -e "s,ACATS4GNATDIR,$dir,g" \ + < $testdir/support/macro.dfs > $dir/support/MACRO.DFS + sed -e "s,ACATS4GNATDIR,$dir,g" \ + < $testdir/support/tsttests.dat > $dir/support/TSTTESTS.DAT + + cp $testdir/tests/cd/*.c $dir/support + cp $testdir/tests/cxb/*.c $dir/support + + rm -rf $dir/run + mv $dir/tests $dir/tests.$$ 2> /dev/null + rm -rf $dir/tests.$$ & + mkdir -p $dir/run + + cp -pr $testdir/tests $dir/ + + for i in $dir/support/*.ada $dir/support/*.a; do + host_gnatchop $i >> $dir/acats.log 2>&1 + done + + # These tools are used to preprocess some ACATS sources + # they need to be compiled native on the host. + + host_gnatmake -q -gnatws macrosub.adb + if [ $? -ne 0 ]; then + display "**** Failed to compile macrosub" + exit 1 + fi + ./macrosub > macrosub.out 2>&1 + + gcc -c cd300051.c + host_gnatmake -q -gnatws widechr.adb + if [ $? -ne 0 ]; then + display "**** Failed to compile widechr" + exit 1 + fi + ./widechr > widechr.out 2>&1 + + rm -f $dir/support/macrosub + rm -f $dir/support/widechr + rm -f $dir/support/*.ali + rm -f $dir/support/*.o + + display " done." + + # From here, all compilations will be made by the target compiler + + display_noeol "Compiling support files..." + + target_gcc -c *.c + if [ $? -ne 0 ]; then + display "**** Failed to compile C code" + exit 1 + fi + + target_gnatchop *.adt >> $dir/acats.log 2>&1 + + target_gnatmake -c -gnato -gnatE *.ads >> $dir/acats.log 2>&1 + target_gnatmake -c -gnato -gnatE *.adb >> $dir/acats.log 2>&1 + + display " done." + display "" + display " === acats tests ===" + + if [ $# -eq 0 ]; then + chapters=`cd $dir/tests; echo [a-z]*` + else + chapters=$* + fi + + glob_countn=0 + glob_countok=0 + glob_countu=0 + + for chapter in $chapters; do + display Running chapter $chapter ... + + if [ ! -d $dir/tests/$chapter ]; then + display "*** CHAPTER $chapter does not exist, skipping." + display "" + continue + fi + + cd $dir/tests/$chapter + ls *.a *.ada *.adt *.am *.dep 2> /dev/null | sed -e 's/\(.*\)\..*/\1/g' | \ + cut -c1-7 | sort | uniq | comm -23 - $testdir/norun.lst \ + > $dir/tests/$chapter/${chapter}.lst + countn=`wc -l < $dir/tests/$chapter/${chapter}.lst` + glob_countn=`expr $glob_countn + $countn` + counti=0 + for i in `cat $dir/tests/$chapter/${chapter}.lst`; do + counti=`expr $counti + 1` + extraflags="" + grep $i $testdir/overflow.lst > /dev/null 2>&1 + if [ $? -eq 0 ]; then + extraflags="$extraflags -gnato" + fi + grep $i $testdir/elabd.lst > /dev/null 2>&1 + if [ $? -eq 0 ]; then + extraflags="$extraflags -gnatE" + fi + test=$dir/tests/$chapter/$i + mkdir $test && cd $test >> $dir/acats.log 2>&1 + + if [ $? -ne 0 ]; then + display "FAIL: $i" + failed="${failed}${i} " + clean_dir + continue + fi + + target_gnatchop -c -w `ls ${test}*.a ${test}*.ada ${test}*.adt ${test}*.am ${test}*.dep 2> /dev/null` >> $dir/acats.log 2>&1 + ls ${i}?.adb > ${i}.lst 2> /dev/null + ls ${i}*m.adb >> ${i}.lst 2> /dev/null + ls ${i}.adb >> ${i}.lst 2> /dev/null + main=`tail -1 ${i}.lst` + binmain=`echo $main | sed -e 's/\(.*\)\..*/\1/g'` + echo "BUILD $main" >> $dir/acats.log + EXTERNAL_OBJECTS="" + case $i in + cxb30*) EXTERNAL_OBJECTS="$dir/support/cxb30040.o $dir/support/cxb30060.o $dir/support/cxb30130.o $dir/support/cxb30131.o";; + ca1020e) rm -f ca1020e_func1.adb ca1020e_func2.adb ca1020e_proc1.adb ca1020e_proc2.adb > /dev/null 2>&1;; + ca14028) rm -f ca14028_func2.ads ca14028_func3.ads ca14028_proc1.ads ca14028_proc3.ads > /dev/null 2>&1;; + cxh1001) extraflags="-a -f"; echo "pragma Normalize_Scalars;" > gnat.adc + esac + if [ "$main" = "" ]; then + display "FAIL: $i" + failed="${failed}${i} " + clean_dir + continue + fi + + target_gnatmake $extraflags -I$dir/support $main >> $dir/acats.log 2>&1 + if [ $? -ne 0 ]; then + display "FAIL: $i" + failed="${failed}${i} " + clean_dir + continue + fi + + echo "RUN $binmain" >> $dir/acats.log + cd $dir/run + target_run $dir/tests/$chapter/$i/$binmain > $dir/tests/$chapter/$i/${i}.log 2>&1 + cd $dir/tests/$chapter/$i + cat ${i}.log >> $dir/acats.log + egrep -e '(==== |\+\+\+\+ |\!\!\!\! )' ${i}.log > /dev/null 2>&1 + if [ $? -ne 0 ]; then + grep 'Tasking not implemented' ${i}.log > /dev/null 2>&1 + + if [ $? -ne 0 ]; then + display "FAIL: $i" + failed="${failed}${i} " + else + log "UNSUPPORTED: $i" + glob_countn=`expr $glob_countn - 1` + glob_countu=`expr $glob_countu + 1` + fi + else + log "PASS: $i" + glob_countok=`expr $glob_countok + 1` + fi + clean_dir + done + done + + display " === acats Summary ===" + display "# of expected passes $glob_countok" + display "# of unexpected failures `expr $glob_countn - $glob_countok`" + + if [ $glob_countu -ne 0 ]; then + display "# of unsupported tests $glob_countu" + fi + + if [ $glob_countok -ne $glob_countn ]; then + display "*** FAILURES: $failed" + fi + + exit 0 diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/acats25.lst gcc-3.4.0/gcc/testsuite/ada/acats/support/acats25.lst *** gcc-3.3.3/gcc/testsuite/ada/acats/support/acats25.lst 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/acats25.lst 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,4308 ---- + a22006b.ada + a22006c.ada + a22006d.ada + a26007a.tst + a27003a.ada + a29003a.ada + a2a031a.ada + a33003a.ada + a34017c.ada + a35101b.ada + a35402a.ada + a35801f.ada + a35902c.ada + a38106d.ada + a38106e.ada + a49027a.ada + a49027b.ada + a49027c.ada + a54b01a.ada + a54b02a.ada + a55b12a.ada + a55b13a.ada + a55b14a.ada + a71004a.ada + a73001i.ada + a73001j.ada + a74105b.ada + a74106a.ada + a74106b.ada + a74106c.ada + a74205e.ada + a74205f.ada + a83009a.ada + a83009b.ada + a83a02a.ada + a83a02b.ada + a83a06a.ada + a83a08a.ada + a83c01c.ada + a83c01h.ada + a83c01i.ada + a85007d.ada + a85013b.ada + a87b59a.ada + a95001c.ada + a95074d.ada + a97106a.ada + a99006a.ada + aa2010a.ada + aa2012a.ada + acats25.lst + ac1015b.ada + ac3106a.ada + ac3206a.ada + ac3207a.ada + ad7001b.ada + ad7001c0.ada + ad7001c1.ada + ad7001d0.ada + ad7001d1.ada + ad7006a.ada + ad7101a.ada + ad7101c.ada + ad7102a.ada + ad7103a.ada + ad7103c.ada + ad7104a.ada + ad7201a.ada + ad7203b.ada + ad7205b.ada + ad8011a.tst + ada101a.ada + ae2113a.ada + ae2113b.ada + ae3002g.ada + ae3101a.ada + ae3702a.ada + ae3709a.ada + b22001a.tst + b22001b.tst + b22001c.tst + b22001d.tst + b22001e.tst + b22001f.tst + b22001g.tst + b22001h.ada + b22001i.tst + b22001j.tst + b22001k.tst + b22001l.tst + b22001m.tst + b22001n.tst + b23002a.ada + b23004a.ada + b23004b.ada + b24001a.ada + b24001b.ada + b24001c.ada + b24005a.ada + b24005b.ada + b24007a.ada + b24009a.ada + b24009b.ada + b24104a.ada + b24204a.ada + b24204b.ada + b24204c.ada + b24204d.ada + b24204e.ada + b24204f.ada + b24205a.ada + b24206a.ada + b24206b.ada + b24211b.ada + b25002a.ada + b25002b.ada + b26001a.ada + b26002a.ada + b26005a.ada + b28001a.ada + b28001b.ada + b28001c.ada + b28001d.ada + b28001e.ada + b28001f.ada + b28001g.ada + b28001h.ada + b28001i.ada + b28001j.ada + b28001k.ada + b28001l.ada + b28001m.ada + b28001n.ada + b28001o.ada + b28001p.ada + b28001q.ada + b28001r.ada + b28001s.ada + b28001t.ada + b28001u.ada + b28001v.ada + b28001w.ada + b29001a.ada + b2a003a.ada + b2a003b.ada + b2a003c.ada + b2a003d.ada + b2a003e.ada + b2a003f.ada + b2a005a.ada + b2a005b.ada + b2a007a.ada + b2a010a.ada + b2a021a.ada + b32101a.ada + b32103a.ada + b32104a.ada + b32106a.ada + b32201a.ada + b32202a.ada + b32202b.ada + b32202c.ada + b330001.a + b33001a.ada + b33101a.ada + b33102a.ada + b33102b.ada + b33102c.ada + b33102d.ada + b33102e.ada + b33201a.ada + b33201b.ada + b33201c.ada + b33201d.ada + b33201e.ada + b33204a.ada + b33205a.ada + b33302a.ada + b34001b.ada + b34001e.ada + b34002b.ada + b34003b.ada + b34004b.ada + b34005b.ada + b34005e.ada + b34005h.ada + b34005k.ada + b34005n.ada + b34005q.ada + b34005t.ada + b34006b.ada + b34006e.ada + b34006h.ada + b34006k.ada + b34007b.ada + b34007e.ada + b34007h.ada + b34007k.ada + b34007n.ada + b34007q.ada + b34007t.ada + b34008b.ada + b34009b.ada + b34009e.ada + b34009h.ada + b34009k.ada + b34011a.ada + b34014b.ada + b34014d.ada + b34014f.ada + b34014i.ada + b34014m.ada + b34014o.ada + b34014q.ada + b34014s.ada + b34014v.ada + b34014z.ada + b35004a.ada + b35101a.ada + b35103a.ada + b35103b.ada + b35302a.ada + b354001.a + b35401a.ada + b35401b.ada + b35403a.ada + b35501a.ada + b35501b.ada + b35506a.ada + b35506b.ada + b35506c.ada + b35506d.ada + b35701a.ada + b35709a.ada + b35901a.ada + b35901c.ada + b35901d.ada + b35a01a.ada + b35a08a.ada + b360001.a + b36001a.ada + b36002a.ada + b36101a.ada + b36102a.ada + b36103a.ada + b36105c.dep + b36171a.ada + b36171b.ada + b36171c.ada + b36171d.ada + b36171e.ada + b36171f.ada + b36171g.ada + b36171h.ada + b36171i.ada + b36201a.ada + b36307a.ada + b370001.a + b370002.a + b37004a.ada + b37004b.ada + b37004c.ada + b37004d.ada + b37004e.ada + b37004f.ada + b37004g.ada + b3710010.a + b3710011.a + b3710012.a + b3710013.a + b3710014.am + b37101a.ada + b37102a.ada + b37104a.ada + b37106a.ada + b37201a.ada + b37201b.ada + b37203a.ada + b37301i.ada + b37301j.ada + b37302a.ada + b37303a.ada + b37309b.ada + b37310b.ada + b37311a.ada + b37401a.ada + b37409b.ada + b380001.a + b38003a.ada + b38003b.ada + b38003c.ada + b38003d.ada + b38008a.ada + b38008b.ada + b38009a.ada + b38009d.ada + b38101a.ada + b38101b.ada + b38101c.ada + b38103a.ada + b38103b.ada + b38103c0.ada + b38103c1.ada + b38103c2.ada + b38103c3.ada + b38103d.ada + b38103e0.ada + b38103e1.ada + b38105a.ada + b38105b.ada + b38203a.ada + b390001.a + b391001.a + b391002.a + b391003.a + b391004.a + b392001.a + b392002.a + b392003.a + b392004.a + b392005.a + b392006.a + b392007.a + b392008.a + b392009.a + b392010.a + b392011.a + b393001.a + b393002.a + b393003.a + b393004.a + b393005.a + b393006.a + b393007.a + b3a0001.a + b3a0002.a + b3a0003.a + b3a0004.a + b3a2002.a + b3a2003.a + b3a2004.a + b3a2005.a + b3a2006.a + b3a2007.a + b3a2008.a + b3a2009.a + b3a2010.a + b3a2011.a + b3a2012.a + b3a2013.a + b3a2014.a + b3a2015.a + b3a2016.a + b41101a.ada + b41101c.ada + b41201a.ada + b41201c.ada + b41202c.ada + b41202d.ada + b41324b.ada + b41325b.ada + b41327b.ada + b420001.a + b430001.a + b43001m.ada + b43002d.ada + b43002e.ada + b43002f.ada + b43002g.ada + b43002h.ada + b43002i.ada + b43002j.ada + b43002k.ada + b43005a.ada + b43005b.ada + b43005f.ada + b43101a.ada + b43102a.ada + b43102b.ada + b43105c.ada + b43201a.ada + b43201c.ada + b43201d.ada + b43202a.ada + b43202c.ada + b43209b.ada + b43221a.ada + b43221b.ada + b43223a.ada + b44001a.ada + b44001b.ada + b44002b.ada + b44002c.ada + b44004a.ada + b44004b.ada + b44004c.ada + b44004d.ada + b44004e.ada + b45102a.ada + b45116a.ada + b45121a.ada + b45204a.ada + b45205a.ada + b45206c.ada + b45207a.ada + b45207b.ada + b45207c.ada + b45207d.ada + b45207g.ada + b45207h.ada + b45207i.ada + b45207j.ada + b45207m.ada + b45207n.ada + b45207o.ada + b45207p.ada + b45207s.ada + b45207t.ada + b45207u.ada + b45207v.ada + b45208a.ada + b45208b.ada + b45208c.ada + b45208g.ada + b45208h.ada + b45208i.ada + b45208m.ada + b45208n.ada + b45208s.ada + b45208t.ada + b45209a.ada + b45209b.ada + b45209c.ada + b45209d.ada + b45209e.ada + b45209f.ada + b45209g.ada + b45209h.ada + b45209i.ada + b45209j.ada + b45209k.ada + b45221a.ada + b45261a.ada + b45261b.ada + b45261c.ada + b45261d.ada + b45301a.ada + b45301b.ada + b45301c.ada + b45302a.ada + b45341a.ada + b455002.a + b45501a.ada + b45501b.ada + b45501c.ada + b45522a.ada + b45537a.ada + b45601a.ada + b45625a.ada + b45661a.ada + b460001.a + b460002.a + b460004.a + b460005.a + b46002a.ada + b46003a.ada + b46004a.ada + b46004b.ada + b46004c.ada + b46004d.ada + b46004e.ada + b46005a.ada + b47001a.ada + b480001.a + b48001a.ada + b48001b.ada + b48002a.ada + b48002b.ada + b48002c.ada + b48002d.ada + b48002e.ada + b48002g.ada + b48003a.ada + b48003b.ada + b48003c.ada + b48003d.ada + b48003e.ada + b490001.a + b490002.a + b49002a.ada + b49004a.ada + b49005a.ada + b49007a.ada + b49007b.ada + b49008a.ada + b49008c.ada + b49009b.ada + b49009c.ada + b49010a.ada + b49011a.ada + b4a010c.ada + b4a016a.ada + b51001a.ada + b51004b.ada + b51004c.ada + b52002a.ada + b52002b.ada + b52002c.ada + b52002d.ada + b52002e.ada + b52002f.ada + b52002g.ada + b52004a.ada + b52004b.ada + b52004c.ada + b52004d.dep + b52004e.dep + b53001a.ada + b53001b.ada + b53002a.ada + b53002b.ada + b53009a.ada + b53009b.ada + b53009c.ada + b54a01b.ada + b54a01f.ada + b54a01g.ada + b54a01l.ada + b54a05a.ada + b54a05b.ada + b54a10a.ada + b54a12a.ada + b54a20a.ada + b54a21a.ada + b54a25a.ada + b54a60a.ada + b54a60b.ada + b54b01b.tst + b54b01c.ada + b54b02b.ada + b54b02c.ada + b54b02d.ada + b54b04a.ada + b54b04b.ada + b54b05a.ada + b54b06a.ada + b55a01a.ada + b55a01d.ada + b55a01e.ada + b55a01j.ada + b55a01k.ada + b55a01l.ada + b55a01n.ada + b55a01o.ada + b55a01t.ada + b55a01u.ada + b55a01v.ada + b55b01a.ada + b55b01b.ada + b55b09b.ada + b55b09c.dep + b55b09d.dep + b55b12b.ada + b55b12c.ada + b55b17a.ada + b55b17b.ada + b55b17c.ada + b55b18a.ada + b56001a.ada + b56001d.ada + b56001e.ada + b56001f.ada + b56001g.ada + b56001h.ada + b57001a.ada + b57001b.ada + b57001c.ada + b57001d.ada + b58001a.ada + b58002a.ada + b58002b.ada + b58002c.ada + b58003a.ada + b58003b.ada + b59001a.ada + b59001c.ada + b59001d.ada + b59001e.ada + b59001f.ada + b59001g.ada + b59001h.ada + b59001i.ada + b610001.a + b61001f.ada + b61005a.ada + b61006a.ada + b61011a.ada + b62001a.ada + b62001b.ada + b62001c.ada + b62001d.ada + b63001a.ada + b63001b.ada + b63005a.ada + b63005b.ada + b63006a.ada + b63009a.ada + b63009b.ada + b63009c0.ada + b63009c1.ada + b63009c2.ada + b63009c3.ada + b63103a.ada + b64002a.ada + b64002c.ada + b64003a.ada + b64004a.ada + b64004b.ada + b64004c.ada + b64004d.ada + b64004e.ada + b64004f.ada + b641001.a + b64101a.ada + b64201a.ada + b65001a.ada + b65002a.ada + b65002b.ada + b660001.a + b660002.a + b66001a.ada + b66001b.ada + b66001c.ada + b66001d.ada + b67001a.ada + b67001b.ada + b67001c.ada + b67001d.ada + b67001h.ada + b67001i.ada + b67001j.ada + b67001k.ada + b67004a.ada + b71001a.ada + b71001b.ada + b71001c.ada + b71001d.ada + b71001f.ada + b71001g.ada + b71001h.ada + b71001i.ada + b71001j.ada + b71001l.ada + b71001m.ada + b71001n.ada + b71001o.ada + b71001p.ada + b71001r.ada + b71001t.ada + b71001u.ada + b71001v.ada + b7200010.a + b7200011.a + b7200012.a + b7200013.a + b7200014.a + b7200015.a + b7200016.a + b730001.a + b730002.a + b730003.a + b730004.a + b730005.a + b7300060.a + b7300061.a + b7300062.a + b7300063.am + b73001a.ada + b73001b.ada + b73001c.ada + b73001d.ada + b73001e.ada + b73001f.ada + b73001g.ada + b73001h.ada + b73004a.ada + b73004b0.ada + b73004b1.ada + b73004b2.ada + b7310010.a + b7310011.a + b7310012.a + b7310013.a + b7310014.a + b7310015.a + b7310016.am + b731a01.a + b731a02.a + b740001.a + b74001a.ada + b74001b.ada + b74101a.ada + b74101b.ada + b74103a.ada + b74103d.ada + b74103e.ada + b74103g.ada + b74103i.ada + b74104a.ada + b74105a.ada + b74105c.ada + b74201a.ada + b74202a.ada + b74202b.ada + b74202c.ada + b74202d.ada + b74203b.ada + b74203c.ada + b74203d.ada + b74203e.ada + b74205a.ada + b74207a.ada + b74304a.ada + b74304b.ada + b74304c.ada + b74404a.ada + b74404b.ada + b74409a.ada + b810001.a + b830001.a + b8300020.a + b8300021.a + b8300022.a + b8300023.a + b8300024.a + b8300025.am + b83001a.ada + b83003a.ada + b83003b0.ada + b83003b1.ada + b83003b2.ada + b83003b3.ada + b83003b4.ada + b83003c.ada + b83004a.ada + b83004b0.ada + b83004b1.ada + b83004b2.ada + b83004b3.ada + b83004c0.ada + b83004c1.ada + b83004c2.ada + b83004d0.ada + b83004d1.ada + b83004d2.ada + b83004d3.ada + b83006a.ada + b83006b.ada + b83008a.ada + b83008b.ada + b83011a.ada + b83023b.ada + b83024b.ada + b83024f0.ada + b83024f1.ada + b83024f2.ada + b83024f3.ada + b83026b.ada + b83027b.ada + b83027d.ada + b83028b.ada + b83029b.ada + b83030b.ada + b83030d.ada + b83031b.ada + b83031d.ada + b83031f.ada + b83032b.ada + b83033b.ada + b83041e.ada + b83a01a.ada + b83a01b.ada + b83a01c.ada + b83a05a.ada + b83a06b.ada + b83a06h.ada + b83a07a.ada + b83a07b.ada + b83a07c.ada + b83a08b.ada + b83a09a.ada + b83b01a.ada + b83b02c.ada + b83e01a.ada + b83e01b.ada + b83e01c.ada + b83e01d.ada + b83e01e0.ada + b83e01e1.ada + b83e01e2.ada + b83e01e3.ada + b83e01f0.ada + b83e01f1.ada + b83e01f2.ada + b83e01f3.ada + b83e01f4.ada + b83e01f5.ada + b83e01f6.ada + b83e11a.ada + b83f02a.ada + b83f02b.ada + b83f02c.ada + b840001.a + b84001a.ada + b84002b.ada + b84004a.ada + b84005b.ada + b84006a.ada + b84007a.ada + b84008b.ada + b85001a.ada + b85001b.ada + b85001c.ada + b85001d.ada + b85001e.ada + b85001f.ada + b85001g.ada + b85001h.ada + b85001i.ada + b85001j.ada + b85001k.ada + b85001l.ada + b85002a.ada + b85003a.ada + b85003b.ada + b85004a.ada + b85008f.ada + b85008g.ada + b85008h.ada + b85010a.ada + b85010b.ada + b85012a.ada + b85013c.ada + b85013d.ada + b85015a.ada + b8510010.a + b8510011.a + b8510012.am + b86001a0.ada + b86001a1.ada + b87b23b.ada + b87b26a.ada + b87b48c.ada + b91001b.ada + b91001c.ada + b91001d.ada + b91001e.ada + b91001f.ada + b91001g.ada + b91002a.ada + b91002b.ada + b91002c.ada + b91002d.ada + b91002e.ada + b91002f.ada + b91002g.ada + b91002h.ada + b91002i.ada + b91002j.ada + b91002k.ada + b91002l.ada + b91003a.ada + b91003b.ada + b91003c.ada + b91003d.ada + b91003e.ada + b91004a.ada + b91005a.ada + b92001a.ada + b92001b.ada + b940001.a + b940002.a + b940003.a + b940004.a + b940005.a + b940006.a + b940007.a + b95001a.ada + b95001b.ada + b95001d.ada + b95002a.ada + b95003a.ada + b95004a.ada + b95004b.ada + b95006a.ada + b95006b.ada + b95006c.ada + b95006d.ada + b95007a.ada + b95007b.ada + b95020a.ada + b95020b0.ada + b95020b1.ada + b95020b2.ada + b95030a.ada + b95031a.ada + b95032a.ada + b95061a.ada + b95061b.ada + b95061c.ada + b95061d.ada + b95061e.ada + b95061f.ada + b95061g.ada + b95062a.ada + b95063a.ada + b95064a.ada + b95068a.ada + b95070a.ada + b95080a.ada + b95080c.ada + b95081a.ada + b95082a.ada + b95082b.ada + b95082c.ada + b95082d.ada + b95082e.ada + b95082f.ada + b95083a.ada + b95094a.ada + b95094b.ada + b95094c.ada + b951001.a + b952001.a + b952002.a + b952003.a + b952004.a + b954001.a + b954003.a + b954004.a + b960001.a + b96002a.ada + b97102b.ada + b97102c.ada + b97102d.ada + b97102f.ada + b97102g.ada + b97102h.ada + b97102i.ada + b97103a.ada + b97103b.ada + b97103d.ada + b97103e.ada + b97103f.ada + b97103g.ada + b97104a.ada + b97104b.ada + b97104c.ada + b97104d.ada + b97104e.ada + b97104f.ada + b97104g.ada + b97107a.ada + b97108a.ada + b97108b.ada + b97109a.ada + b97110a.ada + b97110b.ada + b97111a.ada + b97206a.ada + b97306a.ada + b99001a.ada + b99001b.ada + b99002a.ada + b99002b.ada + b99002c.ada + b99003a.ada + b9a001a.ada + b9a001b.ada + ba1001a0.ada + ba1001a1.ada + ba1001a4.ada + ba1001ac.ada + ba1001d.ada + ba1010a0.ada + ba1010a1.ada + ba1010a2.ada + ba1010a3.ada + ba1010b0.ada + ba1010b1.ada + ba1010b2.ada + ba1010b4.ada + ba1010b5.ada + ba1010b6.ada + ba1010b7.ada + ba1010b8.ada + ba1010c0.ada + ba1010c1.ada + ba1010c2.ada + ba1010c3.ada + ba1010c4.ada + ba1010c5.ada + ba1010c6.ada + ba1010d0.ada + ba1010d1.ada + ba1010d2.ada + ba1010d3.ada + ba1010e0.ada + ba1010e1.ada + ba1010e2.ada + ba1010e3.ada + ba1010e4.ada + ba1010e5.ada + ba1010e6.ada + ba1010f0.ada + ba1010f1.ada + ba1010f3.ada + ba1010f4.ada + ba1010f5.ada + ba1010f6.ada + ba1010f7.ada + ba1010f8.ada + ba1010g0.ada + ba1010g2.ada + ba1010g3.ada + ba1010g4.ada + ba1010g5.ada + ba1010h0.ada + ba1010h2.ada + ba1010i0.ada + ba1010i1.ada + ba1010i3.ada + ba1010i4.ada + ba1010j0.ada + ba1010j1.ada + ba1010j2.ada + ba1010j4.ada + ba1010j5.ada + ba1010j6.ada + ba1010j7.ada + ba1010j8.ada + ba1010k0.ada + ba1010k1.ada + ba1010k2.ada + ba1010k3.ada + ba1010k4.ada + ba1010k5.ada + ba1010k6.ada + ba1010l0.ada + ba1010l1.ada + ba1010l2.ada + ba1010l3.ada + ba1010l4.ada + ba1010l5.ada + ba1010l6.ada + ba1010m0.ada + ba1010m1.ada + ba1010m3.ada + ba1010m4.ada + ba1010m5.ada + ba1010m6.ada + ba1010m7.ada + ba1010m8.ada + ba1010n0.ada + ba1010n2.ada + ba1010n3.ada + ba1010n4.ada + ba1010n5.ada + ba1010p0.ada + ba1010p2.ada + ba1010q0.ada + ba1010q1.ada + ba1010q3.ada + ba1010q4.ada + ba1011b0.ada + ba1011b1.ada + ba1011b2.ada + ba1011b3.ada + ba1011b4.ada + ba1011b5.ada + ba1011b6.ada + ba1011b7.ada + ba1011b8.ada + ba1011c0.ada + ba1011c1.ada + ba1011c2.ada + ba1011c3.ada + ba1011c4.ada + ba1011c5.ada + ba1011c6.ada + ba1011c7.ada + ba1011c8.ada + ba1020a0.ada + ba1020a1.ada + ba1020a2.ada + ba1020a3.ada + ba1020a4.ada + ba1020a5.ada + ba1020a6.ada + ba1020a7.ada + ba1020a8.ada + ba1020b0.ada + ba1020b1.ada + ba1020b2.ada + ba1020b3.ada + ba1020b4.ada + ba1020b5.ada + ba1020b6.ada + ba1020c0.ada + ba1020c1.ada + ba1020c2.ada + ba1020c3.ada + ba1020c4.ada + ba1020c5.ada + ba1020f0.ada + ba1020f1.ada + ba1020f2.ada + ba11001.a + ba11002.a + ba11003.a + ba11004.a + ba11005.a + ba11007.a + ba11008.a + ba11009.a + ba11010.a + ba11011.a + ba11012.a + ba1101a.ada + ba1101b0.ada + ba1101b1.ada + ba1101b2.ada + ba1101b3.ada + ba1101b4.ada + ba1101c0.ada + ba1101c1.ada + ba1101c2.ada + ba1101c3.ada + ba1101c4.ada + ba1101c5.ada + ba1101c6.ada + ba1101e0.ada + ba1101e1.ada + ba1101f.ada + ba1101g.ada + ba1109a0.ada + ba1109a1.ada + ba1109a2.ada + ba1110a0.ada + ba1110a1.ada + ba1110a2.ada + ba1110a3.ada + ba1110a4.ada + ba1110a5.ada + ba12001.a + ba12002.a + ba12003.a + ba12004.a + ba12005.a + ba12007.a + ba12008.a + ba13b01.a + ba13b02.a + ba15001.a + ba150020.a + ba150021.a + ba150022.a + ba150023.a + ba150024.a + ba150025.a + ba150026.a + ba150027.a + ba150028.a + ba150029.am + ba2001a.ada + ba2001b.ada + ba2001c.ada + ba2001d.ada + ba2001f0.ada + ba2001f1.ada + ba2001f2.ada + ba2003b0.ada + ba2003b1.ada + ba2011a0.ada + ba2011a1.ada + ba2011a2.ada + ba2011a3.ada + ba2011a4.ada + ba2011a5.ada + ba2011a6.ada + ba2011a7.ada + ba2011a8.ada + ba2011a9.ada + ba2013a.ada + ba2013b.ada + ba21001.a + ba21002.a + ba210030.a + ba210031.a + ba210032.a + ba210033.a + ba210034.a + ba210035.a + ba210040.a + ba210041.a + ba210042.a + ba210043.a + ba210044.a + ba210045.am + ba21a01.a + ba21a02.a + ba3001a0.ada + ba3001a1.ada + ba3001a2.ada + ba3001a3.ada + ba3001b0.ada + ba3001b1.ada + ba3001c0.ada + ba3001c1.ada + ba3001e0.ada + ba3001e1.ada + ba3001e2.ada + ba3001e3.ada + ba3001f0.ada + ba3001f1.ada + ba3001f2.ada + ba3001f3.ada + ba3006a0.ada + ba3006a1.ada + ba3006a2.ada + ba3006a3.ada + ba3006a4.ada + ba3006a5.ada + ba3006a6.ada + ba3006b0.ada + ba3006b1.ada + ba3006b2.ada + ba3006b3.ada + ba3006b4.ada + bb10001.a + bb20001.a + bb2001a.ada + bb2002a.ada + bb2003a.ada + bb2003b.ada + bb2003c.ada + bb3001a.ada + bb3002a.ada + bc1001a.ada + bc1002a.ada + bc1005a.ada + bc1008a.ada + bc1008b.ada + bc1008c.ada + bc1009a.ada + bc1011a.ada + bc1011b.ada + bc1011c.ada + bc1012a.ada + bc1013a.ada + bc1014a.ada + bc1014b.ada + bc1016a.ada + bc1016b.ada + bc1101a.ada + bc1102a.ada + bc1103a.ada + bc1106a.ada + bc1107a.ada + bc1109a.ada + bc1109b.ada + bc1109c.ada + bc1109d.ada + bc1110a.ada + bc1201a.ada + bc1201b.ada + bc1201c.ada + bc1201d.ada + bc1201e.ada + bc1201f.ada + bc1201g.ada + bc1201h.ada + bc1201i.ada + bc1201j.ada + bc1201k.ada + bc1201l.ada + bc1202a.ada + bc1202c.ada + bc1202e.ada + bc1202f.ada + bc1202g.ada + bc1203a.ada + bc1205a.ada + bc1206a.ada + bc1207a.ada + bc1208a.ada + bc1226a.ada + bc1230a.ada + bc1303a.ada + bc1303b.ada + bc1303c.ada + bc1303d.ada + bc1303e.ada + bc1303f.ada + bc1303g.ada + bc1306a.ada + bc2001b.ada + bc2001c.ada + bc2001d.ada + bc2001e.ada + bc2004a.ada + bc2004b.ada + bc30001.a + bc3001a.ada + bc3002a.ada + bc3002b.ada + bc3002c.ada + bc3002d.ada + bc3002e.ada + bc3005a.ada + bc3005b.ada + bc3005c.ada + bc3006a.ada + bc3009c.ada + bc3011b.ada + bc3013a.ada + bc3016g.ada + bc3018a.ada + bc3101a.ada + bc3101b.ada + bc3102a.ada + bc3102b.ada + bc3103b.ada + bc3123c.ada + bc3201a.ada + bc3201b.ada + bc3201c.ada + bc3202a.ada + bc3202b.ada + bc3202c.ada + bc3202d.ada + bc3205c.ada + bc3301a.ada + bc3301b.ada + bc3302a.ada + bc3302b.ada + bc3303a.ada + bc3304a.ada + bc3401a.ada + bc3401b.ada + bc3402a.ada + bc3402b.ada + bc3403a.ada + bc3403b.ada + bc3403c.ada + bc3404a.ada + bc3404b.ada + bc3404c.ada + bc3404d.ada + bc3404e.ada + bc3404f.ada + bc3405a.ada + bc3405b.ada + bc3405d.ada + bc3405e.ada + bc3405f.ada + bc3501a.ada + bc3501b.ada + bc3501c.ada + bc3501d.ada + bc3501e.ada + bc3501f.ada + bc3501g.ada + bc3501h.ada + bc3501i.ada + bc3501j.ada + bc3501k.ada + bc3502a.ada + bc3502b.ada + bc3502c.ada + bc3502d.ada + bc3502e.ada + bc3502f.ada + bc3502g.ada + bc3502h.ada + bc3502i.ada + bc3502j.ada + bc3502k.ada + bc3502l.ada + bc3502m.ada + bc3502n.ada + bc3502o.ada + bc3503a.ada + bc3503c.ada + bc3503d.ada + bc3503e.ada + bc3503f.ada + bc3604a.ada + bc3604b.ada + bc3607a.ada + bc40001.a + bc40002.a + bc50001.a + bc50002.a + bc50003.a + bc50004.a + bc51002.a + bc51003.a + bc51004.a + bc51005.a + bc51006.a + bc51007.a + bc51011.a + bc51012.a + bc51013.a + bc51015.a + bc51016.a + bc51017.a + bc51018.a + bc51019.a + bc51020.a + bc51b01.a + bc51b02.a + bc51c01.a + bc51c02.a + bc53001.a + bc53002.a + bc54001.a + bc54002.a + bc54003.a + bc54a01.a + bc54a02.a + bc54a03.a + bc54a04.a + bc54a05.a + bc54a06.a + bc70001.a + bc70002.a + bc70003.a + bc70004.a + bc70005.a + bc70006.a + bc70007.a + bc70008.a + bc70009.a + bc70010.a + bd1b01a.ada + bd1b02b.ada + bd1b03c.ada + bd1b05e.ada + bd1b06j.ada + bd2001b.ada + bd2a01h.ada + bd2a02a.tst + bd2a03a.ada + bd2a03b.ada + bd2a06a.ada + bd2a25a.ada + bd2a35a.ada + bd2a45a.ada + bd2a55a.ada + bd2a55b.ada + bd2a67a.ada + bd2a77a.ada + bd2a85a.ada + bd2a85b.ada + bd2b01c.ada + bd2b02a.ada + bd2b03a.ada + bd2b03b.ada + bd2b03c.ada + bd2c01d.tst + bd2c02a.tst + bd2c03a.tst + bd2d01c.ada + bd2d01d.ada + bd2d02a.ada + bd2d03a.ada + bd2d03b.ada + bd3001a.ada + bd3001b.ada + bd3001c.ada + bd3002a.ada + bd3003a.ada + bd3003b.ada + bd3012a.ada + bd3013a.ada + bd4001a.ada + bd4002a.ada + bd4003a.ada + bd4003b.ada + bd4003c.ada + bd4006a.tst + bd4007a.ada + bd4009a.ada + bd4011a.ada + bd5001a.ada + bd5005a.ada + bd5005d.ada + bd5102a.ada + bd5102b.ada + bd5103a.ada + bd5104a.ada + bd7001a.ada + bd7101h.ada + bd7201c.ada + bd7203a.ada + bd7204a.ada + bd7205a.ada + bd7301a.ada + bd7302a.ada + bd8001a.tst + bd8002a.tst + bd8003a.tst + bd8004a.tst + bd8004b.tst + bd8004c.tst + bdb0a01.a + bdd2001.a + bde0001.a + bde0002.a + bde0003.a + bde0004.a + bde0005.a + bde0006.a + bde0007.a + bde0008.a + be2101e.ada + be2101j.ada + be2114a.ada + be2116a.ada + be2208a.ada + be3002a.ada + be3002e.ada + be3205a.ada + be3301c.ada + be3606c.ada + be3703a.ada + be3802a.ada + be3803a.ada + be3902a.ada + be3903a.ada + bxa8001.a + bxac001.a + bxac002.a + bxac003.a + bxac004.a + bxac005.a + bxc3001.a + bxc3002.a + bxc5001.a + bxc6001.a + bxc6002.a + bxc6003.a + bxc6a01.a + bxc6a02.a + bxc6a03.a + bxc6a04.a + bxd1001.a + bxd1002.a + bxe2007.a + bxe2008.a + bxe2009.a + bxe2010.a + bxe2011.a + bxe2012.a + bxe2013.a + bxe2a01.a + bxe2a02.a + bxe2a03.a + bxe2a04.a + bxe2a05.a + bxe2a06.a + bxe4001.a + bxf1001.a + bxh4001.a + bxh4002.a + bxh4003.a + bxh4004.a + bxh4005.a + bxh4006.a + bxh4007.a + bxh4008.a + bxh4009.a + bxh4010.a + bxh4011.a + bxh4012.a + bxh4013.a + c23001a.ada + c23003a.tst + c23003b.tst + c23003g.tst + c23003i.tst + c23006a.ada + c23006b.ada + c23006c.ada + c23006d.ada + c23006e.ada + c23006f.ada + c23006g.ada + c24002d.ada + c24003a.ada + c24003b.ada + c24003c.ada + c24106a.ada + c24202d.ada + c24203a.ada + c24203b.ada + c24207a.ada + c24211a.ada + c250001.aw + c250002.aw + c25001a.ada + c25001b.ada + c26006a.ada + c26008a.ada + c2a001a.ada + c2a001b.ada + c2a001c.ada + c2a002a.ada + c2a008a.ada + c2a021b.ada + c32001a.ada + c32001b.ada + c32001c.ada + c32001d.ada + c32001e.ada + c32107a.ada + c32107c.ada + c32108a.ada + c32108b.ada + c32111a.ada + c32111b.ada + c32112b.ada + c32113a.ada + c32115a.ada + c32115b.ada + c330001.a + c330002.a + c332001.a + c340001.a + c34001a.ada + c34001c.ada + c34001d.ada + c34001f.ada + c34002a.ada + c34002c.ada + c34003a.ada + c34003c.ada + c34004a.ada + c34004c.ada + c34005a.ada + c34005c.ada + c34005d.ada + c34005f.ada + c34005g.ada + c34005i.ada + c34005j.ada + c34005l.ada + c34005m.ada + c34005o.ada + c34005p.ada + c34005r.ada + c34005s.ada + c34005u.ada + c34005v.ada + c34006a.ada + c34006d.ada + c34006f.ada + c34006g.ada + c34006j.ada + c34006l.ada + c34007a.ada + c34007d.ada + c34007f.ada + c34007g.ada + c34007i.ada + c34007j.ada + c34007m.ada + c34007p.ada + c34007r.ada + c34007s.ada + c34007u.ada + c34007v.ada + c34008a.ada + c34009a.ada + c34009d.ada + c34009f.ada + c34009g.ada + c34009j.ada + c34009l.ada + c34011b.ada + c34012a.ada + c34014a.ada + c34014c.ada + c34014e.ada + c34014g.ada + c34014h.ada + c34014n.ada + c34014p.ada + c34014r.ada + c34014t.ada + c34014u.ada + c34018a.ada + c340a01.a + c340a02.a + c341a01.a + c341a02.a + c341a03.a + c341a04.a + c35003a.ada + c35003b.ada + c35003d.ada + c35102a.ada + c352001.a + c354002.a + c354003.a + c35502a.ada + c35502b.ada + c35502c.ada + c35502d.tst + c35502e.ada + c35502f.tst + c35502g.ada + c35502h.ada + c35502i.ada + c35502j.ada + c35502k.ada + c35502l.ada + c35502m.ada + c35502n.ada + c35502o.ada + c35502p.ada + c35503a.ada + c35503b.ada + c35503c.ada + c35503d.tst + c35503e.ada + c35503f.tst + c35503g.ada + c35503h.ada + c35503k.ada + c35503l.ada + c35503o.ada + c35503p.ada + c35504a.ada + c35504b.ada + c35505c.ada + c35505e.ada + c35505f.ada + c35507a.ada + c35507b.ada + c35507c.ada + c35507e.ada + c35507g.ada + c35507h.ada + c35507i.ada + c35507j.ada + c35507k.ada + c35507l.ada + c35507m.ada + c35507n.ada + c35507o.ada + c35507p.ada + c35508a.ada + c35508b.ada + c35508c.ada + c35508e.ada + c35508g.ada + c35508h.ada + c35508k.ada + c35508l.ada + c35508o.ada + c35508p.ada + c35703a.ada + c35704a.ada + c35704b.ada + c35704c.ada + c35704d.ada + c35801d.ada + c35902d.ada + c35904a.ada + c35904b.ada + c35a02a.ada + c35a05a.ada + c35a05d.ada + c35a05n.ada + c35a05q.ada + c35a07a.ada + c35a07d.ada + c35a08b.ada + c360002.a + c36104a.ada + c36104b.ada + c36172a.ada + c36172b.ada + c36172c.ada + c36174a.ada + c36180a.ada + c36202c.ada + c36203a.ada + c36204a.ada + c36204b.ada + c36204c.ada + c36204d.ada + c36205a.ada + c36205b.ada + c36205c.ada + c36205d.ada + c36205e.ada + c36205f.ada + c36205g.ada + c36205h.ada + c36205i.ada + c36205j.ada + c36205k.ada + c36205l.ada + c36301a.ada + c36301b.ada + c36302a.ada + c36304a.ada + c36305a.ada + c37002a.ada + c37003a.ada + c37003b.ada + c37005a.ada + c37006a.ada + c37008a.ada + c37008b.ada + c37009a.ada + c37010a.ada + c37010b.ada + c371001.a + c371002.a + c371003.a + c37102b.ada + c37103a.ada + c37105a.ada + c37107a.ada + c37108b.ada + c37206a.ada + c37207a.ada + c37208a.ada + c37208b.ada + c37209a.ada + c37209b.ada + c37210a.ada + c37211a.ada + c37211b.ada + c37211c.ada + c37211d.ada + c37211e.ada + c37213b.ada + c37213d.ada + c37213f.ada + c37213h.ada + c37213j.ada + c37213k.ada + c37213l.ada + c37215b.ada + c37215d.ada + c37215f.ada + c37215h.ada + c37217a.ada + c37217b.ada + c37217c.ada + c37304a.ada + c37305a.ada + c37306a.ada + c37309a.ada + c37310a.ada + c37312a.ada + c37402a.ada + c37403a.ada + c37404a.ada + c37404b.ada + c37405a.ada + c37411a.ada + c38002a.ada + c38002b.ada + c38005a.ada + c38005b.ada + c38005c.ada + c38006a.ada + c38102a.ada + c38102b.ada + c38102c.ada + c38102d.ada + c38102e.ada + c38104a.ada + c38107a.ada + c38107b.ada + c38108a.ada + c38108b.ada + c38108c0.ada + c38108c1.ada + c38108c2.ada + c38108d0.ada + c38108d1.ada + c38202a.ada + c3900010.a + c3900011.am + c390002.a + c390003.a + c390004.a + c3900050.a + c3900051.a + c3900052.a + c3900053.am + c3900060.a + c3900061.a + c3900062.a + c3900063.am + c390007.a + c390010.a + c390011.a + c39006a.ada + c39006b.ada + c39006c0.ada + c39006c1.ada + c39006d.ada + c39006e.ada + c39006f0.ada + c39006f1.ada + c39006f2.ada + c39006f3.ada + c39006g.ada + c39007a.ada + c39007b.ada + c39008a.ada + c39008b.ada + c39008c.ada + c390a010.a + c390a011.am + c390a020.a + c390a021.a + c390a022.am + c390a030.a + c390a031.am + c391001.a + c391002.a + c392002.a + c392003.a + c392004.a + c392005.a + c392008.a + c392010.a + c392011.a + c392013.a + c392014.a + c392a01.a + c392c05.a + c392c07.a + c392d01.a + c392d02.a + c392d03.a + c393001.a + c393007.a + c393008.a + c393009.a + c393010.a + c393011.a + c393012.a + c393a02.a + c393a03.a + c393a05.a + c393a06.a + c393b12.a + c393b13.a + c393b14.a + c3a0001.a + c3a0002.a + c3a0003.a + c3a0004.a + c3a0005.a + c3a0006.a + c3a0007.a + c3a0008.a + c3a0009.a + c3a0010.a + c3a0011.a + c3a00120.a + c3a00121.a + c3a00122.am + c3a0013.a + c3a0014.a + c3a0015.a + c3a1001.a + c3a1002.a + c3a2001.a + c3a2002.a + c3a2003.a + c3a2a01.a + c3a2a02.a + c410001.a + c41101d.ada + c41103a.ada + c41103b.ada + c41104a.ada + c41105a.ada + c41107a.ada + c41201d.ada + c41203a.ada + c41203b.ada + c41204a.ada + c41205a.ada + c41206a.ada + c41207a.ada + c41301a.ada + c41303a.ada + c41303b.ada + c41303c.ada + c41303e.ada + c41303f.ada + c41303g.ada + c41303i.ada + c41303j.ada + c41303k.ada + c41303m.ada + c41303n.ada + c41303o.ada + c41303q.ada + c41303r.ada + c41303s.ada + c41303u.ada + c41303v.ada + c41303w.ada + c41304a.ada + c41304b.ada + c41306a.ada + c41306b.ada + c41306c.ada + c41307d.ada + c41309a.ada + c41320a.ada + c41321a.ada + c41322a.ada + c41323a.ada + c41324a.ada + c41325a.ada + c41326a.ada + c41327a.ada + c41328a.ada + c41401a.ada + c41402a.ada + c41404a.ada + c420001.a + c42006a.ada + c42007e.ada + c43003a.ada + c43004a.ada + c43004c.ada + c431001.a + c43103a.ada + c43103b.ada + c43104a.ada + c43105a.ada + c43105b.ada + c43106a.ada + c43107a.ada + c43108a.ada + c432001.a + c432002.a + c432003.a + c432004.a + c43204a.ada + c43204c.ada + c43204e.ada + c43204f.ada + c43204g.ada + c43204h.ada + c43204i.ada + c43205a.ada + c43205b.ada + c43205c.ada + c43205d.ada + c43205e.ada + c43205g.ada + c43205h.ada + c43205i.ada + c43205j.ada + c43205k.ada + c43206a.ada + c43207b.ada + c43207d.ada + c43208a.ada + c43208b.ada + c43209a.ada + c43210a.ada + c43211a.ada + c43212a.ada + c43212c.ada + c43214a.ada + c43214b.ada + c43214c.ada + c43214d.ada + c43214e.ada + c43214f.ada + c43215a.ada + c43215b.ada + c43222a.ada + c43224a.ada + c433001.a + c44003d.ada + c44003f.ada + c44003g.ada + c450001.a + c45112a.ada + c45112b.ada + c45113a.ada + c45114b.ada + c452001.a + c45201a.ada + c45201b.ada + c45202b.ada + c45210a.ada + c45211a.ada + c45220a.ada + c45220b.ada + c45220c.ada + c45220d.ada + c45220e.ada + c45220f.ada + c45231a.ada + c45231b.dep + c45231c.dep + c45231d.tst + c45232b.ada + c45242b.ada + c45251a.ada + c45252a.ada + c45252b.ada + c45253a.ada + c45262a.ada + c45262b.ada + c45262c.ada + c45262d.ada + c45264a.ada + c45264b.ada + c45264c.ada + c45265a.ada + c45271a.ada + c45272a.ada + c45273a.ada + c45274a.ada + c45274b.ada + c45274c.ada + c45281a.ada + c45282a.ada + c45282b.ada + c45291a.ada + c45303a.ada + c45304a.ada + c45304b.dep + c45304c.dep + c45322a.ada + c45323a.ada + c45331a.ada + c45342a.ada + c45343a.ada + c45344a.ada + c45345b.ada + c45347a.ada + c45347b.ada + c45347c.ada + c45347d.ada + c45411a.ada + c45411b.dep + c45411c.dep + c45411d.ada + c45413a.ada + c45431a.ada + c455001.a + c45502b.dep + c45502c.dep + c45503a.ada + c45503b.dep + c45503c.dep + c45504a.ada + c45504b.dep + c45504c.dep + c45504d.ada + c45504e.dep + c45504f.dep + c45505a.ada + c45523a.ada + c45531a.ada + c45531b.ada + c45531c.ada + c45531d.ada + c45531e.ada + c45531f.ada + c45531g.ada + c45531h.ada + c45531i.ada + c45531j.ada + c45531k.ada + c45531l.ada + c45531m.dep + c45531n.dep + c45531o.dep + c45531p.dep + c45532a.ada + c45532b.ada + c45532c.ada + c45532d.ada + c45532e.ada + c45532f.ada + c45532g.ada + c45532h.ada + c45532i.ada + c45532j.ada + c45532k.ada + c45532l.ada + c45532m.dep + c45532n.dep + c45532o.dep + c45532p.dep + c45534b.ada + c45536a.dep + c45611a.ada + c45611b.dep + c45611c.dep + c45613a.ada + c45613b.dep + c45613c.dep + c45614a.ada + c45614b.dep + c45614c.dep + c45622a.ada + c45624a.ada + c45624b.ada + c45631a.ada + c45631b.dep + c45631c.dep + c45632a.ada + c45632b.dep + c45632c.dep + c45651a.ada + c45662a.ada + c45662b.ada + c45672a.ada + c460001.a + c460002.a + c460004.a + c460005.a + c460006.a + c460007.a + c460008.a + c460009.a + c460010.a + c460011.a + c460012.a + c46011a.ada + c46013a.ada + c46014a.ada + c46021a.ada + c46024a.ada + c46031a.ada + c46032a.ada + c46033a.ada + c46041a.ada + c46042a.ada + c46043b.ada + c46044b.ada + c46051a.ada + c46051b.ada + c46051c.ada + c46052a.ada + c46053a.ada + c46054a.ada + c460a01.a + c460a02.a + c47002a.ada + c47002b.ada + c47002c.ada + c47002d.ada + c47003a.ada + c47004a.ada + c47005a.ada + c47006a.ada + c47007a.ada + c47008a.ada + c47009a.ada + c47009b.ada + c48004a.ada + c48004b.ada + c48004c.ada + c48004d.ada + c48004e.ada + c48004f.ada + c48005a.ada + c48005b.ada + c48006a.ada + c48006b.ada + c48007a.ada + c48007b.ada + c48007c.ada + c48008a.ada + c48008c.ada + c48009a.ada + c48009b.ada + c48009c.ada + c48009d.ada + c48009e.ada + c48009f.ada + c48009g.ada + c48009h.ada + c48009i.ada + c48009j.ada + c48010a.ada + c48011a.ada + c48012a.ada + c490001.a + c490002.a + c490003.a + c49020a.ada + c49021a.ada + c49022a.ada + c49022b.ada + c49022c.ada + c49023a.ada + c49024a.ada + c49025a.ada + c49026a.ada + c4a005b.ada + c4a006a.ada + c4a007a.tst + c4a010a.ada + c4a010b.ada + c4a011a.ada + c4a012b.ada + c4a013a.ada + c4a014a.ada + c51004a.ada + c52005a.ada + c52005b.ada + c52005c.ada + c52005d.ada + c52005e.ada + c52005f.ada + c52008a.ada + c52008b.ada + c52009a.ada + c52009b.ada + c52010a.ada + c52011a.ada + c52011b.ada + c52101a.ada + c52102a.ada + c52102b.ada + c52102c.ada + c52102d.ada + c52103a.ada + c52103b.ada + c52103c.ada + c52103f.ada + c52103g.ada + c52103h.ada + c52103k.ada + c52103l.ada + c52103m.ada + c52103p.ada + c52103q.ada + c52103r.ada + c52103x.ada + c52104a.ada + c52104b.ada + c52104c.ada + c52104f.ada + c52104g.ada + c52104h.ada + c52104k.ada + c52104l.ada + c52104m.ada + c52104p.ada + c52104q.ada + c52104r.ada + c52104x.ada + c52104y.ada + c53007a.ada + c540001.a + c54a03a.ada + c54a04a.ada + c54a07a.ada + c54a13a.ada + c54a13b.ada + c54a13c.ada + c54a13d.ada + c54a22a.ada + c54a23a.ada + c54a24a.ada + c54a24b.ada + c54a42a.ada + c54a42b.ada + c54a42c.ada + c54a42d.ada + c54a42e.ada + c54a42f.ada + c54a42g.ada + c55b03a.ada + c55b04a.ada + c55b05a.ada + c55b06a.ada + c55b06b.ada + c55b07a.dep + c55b07b.dep + c55b10a.ada + c55b11a.ada + c55b11b.ada + c55b15a.ada + c55b16a.ada + c55c02a.ada + c55c02b.ada + c56002a.ada + c57003a.ada + c57004a.ada + c57004b.ada + c58004c.ada + c58004d.ada + c58004g.ada + c58005a.ada + c58005b.ada + c58005h.ada + c58006a.ada + c58006b.ada + c59002a.ada + c59002b.ada + c59002c.ada + c61008a.ada + c61009a.ada + c61010a.ada + c62002a.ada + c62003a.ada + c62003b.ada + c62004a.ada + c62006a.ada + c631001.a + c640001.a + c64002b.ada + c64004g.ada + c64005a.ada + c64005b.ada + c64005c.ada + c64005d0.ada + c64005da.ada + c64005db.ada + c64005dc.ada + c641001.a + c64103b.ada + c64103c.ada + c64103d.ada + c64103e.ada + c64103f.ada + c64104a.ada + c64104b.ada + c64104c.ada + c64104d.ada + c64104e.ada + c64104f.ada + c64104g.ada + c64104h.ada + c64104i.ada + c64104j.ada + c64104k.ada + c64104l.ada + c64104m.ada + c64104n.ada + c64104o.ada + c64105a.ada + c64105b.ada + c64105c.ada + c64105d.ada + c64106a.ada + c64106b.ada + c64106c.ada + c64106d.ada + c64107a.ada + c64108a.ada + c64109a.ada + c64109b.ada + c64109c.ada + c64109d.ada + c64109e.ada + c64109f.ada + c64109g.ada + c64109h.ada + c64109i.ada + c64109j.ada + c64109k.ada + c64109l.ada + c64201b.ada + c64201c.ada + c64202a.ada + c650001.a + c65003a.ada + c65003b.ada + c66002a.ada + c66002c.ada + c66002d.ada + c66002e.ada + c66002f.ada + c66002g.ada + c67002a.ada + c67002b.ada + c67002c.ada + c67002d.ada + c67002e.ada + c67003f.ada + c67005a.ada + c67005b.ada + c67005c.ada + c67005d.ada + c72001b.ada + c72002a.ada + c730001.a + c730002.a + c730003.a + c730004.a + c73002a.ada + c730a01.a + c730a02.a + c731001.a + c74004a.ada + c74203a.ada + c74206a.ada + c74207b.ada + c74208a.ada + c74208b.ada + c74209a.ada + c74210a.ada + c74211a.ada + c74211b.ada + c74302a.ada + c74302b.ada + c74305a.ada + c74305b.ada + c74306a.ada + c74307a.ada + c74401d.ada + c74401e.ada + c74401k.ada + c74401q.ada + c74402a.ada + c74402b.ada + c74406a.ada + c74407b.ada + c74409b.ada + c760001.a + c760002.a + c760007.a + c760009.a + c760010.a + c760011.a + c760012.a + c760013.a + c761001.a + c761002.a + c761003.a + c761004.a + c761005.a + c761006.a + c761007.a + c761010.a + c761011.a + c83007a.ada + c83012d.ada + c83022a.ada + c83022g0.ada + c83022g1.ada + c83023a.ada + c83024a.ada + c83024e0.ada + c83024e1.ada + c83025a.ada + c83025c.ada + c83027a.ada + c83027c.ada + c83028a.ada + c83029a.ada + c83030a.ada + c83030c.ada + c83031a.ada + c83031c.ada + c83031e.ada + c83032a.ada + c83033a.ada + c83051a.ada + c83b02a.ada + c83b02b.ada + c83e02a.ada + c83e02b.ada + c83e03a.ada + c83f01a.ada + c83f01b.ada + c83f01c0.ada + c83f01c1.ada + c83f01c2.ada + c83f01d0.ada + c83f01d1.ada + c83f03a.ada + c83f03b.ada + c83f03c0.ada + c83f03c1.ada + c83f03c2.ada + c83f03d0.ada + c83f03d1.ada + c840001.a + c84002a.ada + c84005a.ada + c84008a.ada + c84009a.ada + c85004b.ada + c85005a.ada + c85005b.ada + c85005c.ada + c85005d.ada + c85005e.ada + c85005f.ada + c85005g.ada + c85006a.ada + c85006b.ada + c85006c.ada + c85006d.ada + c85006e.ada + c85006f.ada + c85006g.ada + c85007a.ada + c85007e.ada + c85009a.ada + c85011a.ada + c85013a.ada + c85014a.ada + c85014b.ada + c85014c.ada + c85017a.ada + c85018a.ada + c85018b.ada + c85019a.ada + c854001.a + c854002.a + c86003a.ada + c86004a.ada + c86004b0.ada + c86004b1.ada + c86004b2.ada + c86004c0.ada + c86004c1.ada + c86004c2.ada + c86006i.ada + c86007a.ada + c87a05a.ada + c87a05b.ada + c87b02a.ada + c87b02b.ada + c87b03a.ada + c87b04a.ada + c87b04b.ada + c87b04c.ada + c87b05a.ada + c87b06a.ada + c87b07a.ada + c87b07b.ada + c87b07c.ada + c87b07d.ada + c87b07e.ada + c87b08a.ada + c87b09a.ada + c87b09c.ada + c87b10a.ada + c87b11a.ada + c87b11b.ada + c87b13a.ada + c87b14a.ada + c87b14b.ada + c87b14c.ada + c87b14d.ada + c87b15a.ada + c87b16a.ada + c87b17a.ada + c87b18a.ada + c87b18b.ada + c87b19a.ada + c87b23a.ada + c87b24a.ada + c87b24b.ada + c87b26b.ada + c87b27a.ada + c87b28a.ada + c87b29a.ada + c87b30a.ada + c87b31a.ada + c87b32a.ada + c87b33a.ada + c87b34a.ada + c87b34b.ada + c87b34c.ada + c87b35c.ada + c87b38a.ada + c87b39a.ada + c87b40a.ada + c87b41a.ada + c87b42a.ada + c87b43a.ada + c87b44a.ada + c87b45a.ada + c87b45c.ada + c87b47a.ada + c87b48a.ada + c87b48b.ada + c87b50a.ada + c87b54a.ada + c87b57a.ada + c87b62a.ada + c87b62b.ada + c87b62c.ada + c87b62d.tst + c910001.a + c910002.a + c910003.a + c91004b.ada + c91004c.ada + c91006a.ada + c91007a.ada + c92002a.ada + c92003a.ada + c92005a.ada + c92005b.ada + c92006a.ada + c930001.a + c93001a.ada + c93002a.ada + c93003a.ada + c93004a.ada + c93004b.ada + c93004c.ada + c93004d.ada + c93004f.ada + c93005a.ada + c93005b.ada + c93005c.ada + c93005d.ada + c93005e.ada + c93005f.ada + c93005g.ada + c93005h.ada + c93006a.ada + c93007a.ada + c93008a.ada + c93008b.ada + c940001.a + c940002.a + c940004.a + c940005.a + c940006.a + c940007.a + c940010.a + c940011.a + c940012.a + c940013.a + c940014.a + c940015.a + c940016.a + c94001a.ada + c94001b.ada + c94001c.ada + c94001e.ada + c94001f.ada + c94001g.ada + c94002a.ada + c94002b.ada + c94002d.ada + c94002e.ada + c94002f.ada + c94002g.ada + c94004a.ada + c94004b.ada + c94004c.ada + c94005a.ada + c94005b.ada + c94006a.ada + c94007a.ada + c94007b.ada + c94008a.ada + c94008b.ada + c94008c.ada + c94008d.ada + c94010a.ada + c94011a.ada + c94020a.ada + c940a03.a + c95008a.ada + c95009a.ada + c95010a.ada + c95011a.ada + c95012a.ada + c95021a.ada + c95022a.ada + c95022b.ada + c95033a.ada + c95033b.ada + c95034a.ada + c95034b.ada + c95035a.ada + c95040a.ada + c95040b.ada + c95040c.ada + c95040d.ada + c95041a.ada + c95065a.ada + c95065b.ada + c95065c.ada + c95065d.ada + c95065e.ada + c95065f.ada + c95066a.ada + c95067a.ada + c95071a.ada + c95072a.ada + c95072b.ada + c95073a.ada + c95074c.ada + c95076a.ada + c95078a.ada + c95080b.ada + c95082g.ada + c95085a.ada + c95085b.ada + c95085c.ada + c95085d.ada + c95085e.ada + c95085f.ada + c95085g.ada + c95085h.ada + c95085i.ada + c95085j.ada + c95085k.ada + c95085l.ada + c95085m.ada + c95085n.ada + c95085o.ada + c95086a.ada + c95086b.ada + c95086c.ada + c95086d.ada + c95086e.ada + c95086f.ada + c95087a.ada + c95087b.ada + c95087c.ada + c95087d.ada + c95088a.ada + c95089a.ada + c95090a.ada + c95092a.ada + c95093a.ada + c95095a.ada + c95095b.ada + c95095c.ada + c95095d.ada + c95095e.ada + c951001.a + c951002.a + c953001.a + c953002.a + c953003.a + c954001.a + c954010.a + c954011.a + c954012.a + c954013.a + c954014.a + c954015.a + c954016.a + c954017.a + c954018.a + c954019.a + c954020.a + c954021.a + c954022.a + c954023.a + c954024.a + c954025.a + c954026.a + c954a01.a + c954a02.a + c954a03.a + c960001.a + c960002.a + c960004.a + c96001a.ada + c96004a.ada + c96005a.ada + c96005b.tst + c96005d.ada + c96005f.ada + c96006a.ada + c96007a.ada + c96008a.ada + c96008b.ada + c97112a.ada + c97113a.ada + c97114a.ada + c97115a.ada + c97116a.ada + c97117a.ada + c97117b.ada + c97117c.ada + c97118a.ada + c97120a.ada + c97120b.ada + c97201a.ada + c97201b.ada + c97201c.ada + c97201d.ada + c97201e.ada + c97201g.ada + c97201h.ada + c97201x.ada + c97202a.ada + c97203a.ada + c97203b.ada + c97203c.ada + c97204a.ada + c97204b.ada + c97205a.ada + c97205b.ada + c97301a.ada + c97301b.ada + c97301c.ada + c97301d.ada + c97301e.ada + c97302a.ada + c97303a.ada + c97303b.ada + c97303c.ada + c97304a.ada + c97304b.ada + c97305a.ada + c97305b.ada + c97305c.ada + c97305d.ada + c97307a.ada + c974001.a + c974002.a + c974003.a + c974004.a + c974005.a + c974006.a + c974007.a + c974008.a + c974009.a + c974010.a + c974011.a + c974012.a + c974013.a + c974014.a + c980001.a + c980002.a + c980003.a + c99004a.ada + c99005a.ada + c9a003a.ada + c9a004a.ada + c9a007a.ada + c9a009a.ada + c9a009c.ada + c9a009f.ada + c9a009g.ada + c9a009h.ada + c9a010a.ada + c9a011a.ada + c9a011b.ada + ca1003a.ada + ca1004a.ada + ca1005a.ada + ca1006a.ada + ca1011a0.ada + ca1011a1.ada + ca1011a2.ada + ca1011a3.ada + ca1011a4.ada + ca1011a5.ada + ca1011a6.ada + ca1012a0.ada + ca1012a1.ada + ca1012a2.ada + ca1012a3.ada + ca1012a4.ada + ca1012b0.ada + ca1012b2.ada + ca1012b4.ada + ca1013a0.ada + ca1013a1.ada + ca1013a2.ada + ca1013a3.ada + ca1013a4.ada + ca1013a5.ada + ca1013a6.ada + ca1014a0.ada + ca1014a1.ada + ca1014a2.ada + ca1014a3.ada + ca1020e0.ada + ca1020e1.ada + ca1020e2.ada + ca1020e3.ada + ca1022a0.ada + ca1022a1.ada + ca1022a2.ada + ca1022a3.ada + ca1022a4.ada + ca1022a5.ada + ca1022a6.ada + ca11001.a + ca11002.a + ca11003.a + ca110040.a + ca110041.a + ca110042.am + ca110050.a + ca110051.am + ca11006.a + ca11007.a + ca11008.a + ca11009.a + ca11010.a + ca11011.a + ca11012.a + ca11013.a + ca11014.a + ca11015.a + ca11016.a + ca11017.a + ca11018.a + ca11019.a + ca11020.a + ca11021.a + ca11022.a + ca1102a0.ada + ca1102a1.ada + ca1102a2.ada + ca1106a.ada + ca1108a.ada + ca1108b.ada + ca11a01.a + ca11a02.a + ca11b01.a + ca11b02.a + ca11c01.a + ca11c02.a + ca11c03.a + ca11d010.a + ca11d011.a + ca11d012.a + ca11d013.am + ca11d02.a + ca11d03.a + ca13001.a + ca13002.a + ca13003.a + ca13a01.a + ca13a02.a + ca140230.a + ca140231.a + ca140232.am + ca140233.a + ca140280.a + ca140281.a + ca140282.a + ca140283.am + ca15003.a + ca200020.a + ca200021.a + ca200022.am + ca2001h0.ada + ca2001h1.ada + ca2001h2.ada + ca2001h3.ada + ca2002a0.ada + ca2002a1.ada + ca2002a2.ada + ca2003a0.ada + ca2003a1.ada + ca2004a0.ada + ca2004a1.ada + ca2004a2.ada + ca2004a3.ada + ca2004a4.ada + ca2007a0.ada + ca2007a1.ada + ca2007a2.ada + ca2007a3.ada + ca2008a0.ada + ca2008a1.ada + ca2008a2.ada + ca2009a.ada + ca2009c0.ada + ca2009c1.ada + ca2009d.ada + ca2009f0.ada + ca2009f1.ada + ca2009f2.ada + ca2011b.ada + ca21001.a + ca3011a0.ada + ca3011a1.ada + ca3011a2.ada + ca3011a3.ada + ca3011a4.ada + ca5003a0.ada + ca5003a1.ada + ca5003a2.ada + ca5003a3.ada + ca5003a4.ada + ca5003a5.ada + ca5003a6.ada + ca5003b0.ada + ca5003b1.ada + ca5003b2.ada + ca5003b3.ada + ca5003b4.ada + ca5003b5.ada + ca5004a.ada + ca5004b0.ada + ca5004b1.ada + ca5004b2.ada + ca5006a.ada + cb10002.a + cb1001a.ada + cb1004a.ada + cb1005a.ada + cb1010a.ada + cb1010c.ada + cb1010d.ada + cb20001.a + cb20003.a + cb20004.a + cb20005.a + cb20006.a + cb20007.a + cb2004a.ada + cb2005a.ada + cb2006a.ada + cb2007a.ada + cb20a02.a + cb3003a.ada + cb3003b.ada + cb3004a.ada + cb40005.a + cb4001a.ada + cb4002a.ada + cb4003a.ada + cb4004a.ada + cb4005a.ada + cb4006a.ada + cb4007a.ada + cb4008a.ada + cb4009a.ada + cb4013a.ada + cb40a01.a + cb40a020.a + cb40a021.am + cb40a030.a + cb40a031.am + cb40a04.a + cb41001.a + cb41002.a + cb41003.a + cb41004.a + cb5001a.ada + cb5001b.ada + cb5002a.ada + cc1004a.ada + cc1005b.ada + cc1010a.ada + cc1010b.ada + cc1018a.ada + cc1104c.ada + cc1107b.ada + cc1111a.ada + cc1204a.ada + cc1207b.ada + cc1220a.ada + cc1221a.ada + cc1221b.ada + cc1221c.ada + cc1221d.ada + cc1222a.ada + cc1223a.ada + cc1224a.ada + cc1225a.tst + cc1226b.ada + cc1227a.ada + cc1301a.ada + cc1302a.ada + cc1304a.ada + cc1304b.ada + cc1307a.ada + cc1307b.ada + cc1308a.ada + cc1310a.ada + cc1311a.ada + cc1311b.ada + cc2002a.ada + cc30001.a + cc30002.a + cc3004a.ada + cc3007a.ada + cc3007b.ada + cc3011a.ada + cc3011d.ada + cc3012a.ada + cc3015a.ada + cc3016b.ada + cc3016c.ada + cc3016f.ada + cc3016i.ada + cc3017b.ada + cc3017c.ada + cc3019a.ada + cc3019b0.ada + cc3019b1.ada + cc3019b2.ada + cc3019c0.ada + cc3019c1.ada + cc3019c2.ada + cc3106b.ada + cc3120a.ada + cc3120b.ada + cc3121a.ada + cc3123a.ada + cc3125a.ada + cc3125b.ada + cc3125c.ada + cc3125d.ada + cc3126a.ada + cc3127a.ada + cc3128a.ada + cc3203a.ada + cc3207b.ada + cc3220a.ada + cc3221a.ada + cc3222a.ada + cc3223a.ada + cc3224a.ada + cc3225a.ada + cc3230a.ada + cc3231a.ada + cc3232a.ada + cc3233a.ada + cc3234a.ada + cc3235a.ada + cc3236a.ada + cc3240a.ada + cc3305a.ada + cc3305b.ada + cc3305c.ada + cc3305d.ada + cc3601a.ada + cc3601c.ada + cc3602a.ada + cc3603a.ada + cc3605a.ada + cc3606a.ada + cc3606b.ada + cc3607b.ada + cc40001.a + cc50001.a + cc50a01.a + cc50a02.a + cc51001.a + cc51002.a + cc51003.a + cc51004.a + cc51006.a + cc51007.a + cc51a01.a + cc51b03.a + cc51d01.a + cc51d02.a + cc54001.a + cc54002.a + cc54003.a + cc54004.a + cc70001.a + cc70002.a + cc70003.a + cc70a01.a + cc70a02.a + cc70b01.a + cc70b02.a + cc70c01.a + cc70c02.a + cd10001.a + cd1009a.ada + cd1009b.ada + cd1009d.ada + cd1009e.ada + cd1009f.ada + cd1009g.ada + cd1009h.ada + cd1009i.ada + cd1009j.ada + cd1009k.tst + cd1009l.ada + cd1009m.ada + cd1009n.ada + cd1009o.ada + cd1009p.ada + cd1009q.ada + cd1009r.ada + cd1009s.ada + cd1009t.tst + cd1009u.tst + cd1009v.ada + cd1009w.ada + cd1009x.ada + cd1009y.ada + cd1009z.ada + cd1c03a.ada + cd1c03b.ada + cd1c03c.ada + cd1c03e.tst + cd1c03f.ada + cd1c03g.ada + cd1c03h.ada + cd1c03i.ada + cd1c04a.ada + cd1c04d.ada + cd1c04e.ada + cd1c06a.tst + cd20001.a + cd2a21a.ada + cd2a21c.ada + cd2a21e.ada + cd2a22a.ada + cd2a22e.ada + cd2a22i.ada + cd2a22j.ada + cd2a23a.ada + cd2a23e.ada + cd2a24a.ada + cd2a24e.ada + cd2a24i.ada + cd2a24j.ada + cd2a31a.ada + cd2a31c.ada + cd2a31e.ada + cd2a32a.ada + cd2a32c.ada + cd2a32e.ada + cd2a32g.ada + cd2a32i.ada + cd2a32j.ada + cd2a51a.ada + cd2a53a.ada + cd2a53e.ada + cd2a83c.tst + cd2a91c.tst + cd2b11a.ada + cd2b11b.ada + cd2b11d.ada + cd2b11e.ada + cd2b11f.ada + cd2b15c.ada + cd2b16a.ada + cd2c11a.tst + cd2c11d.tst + cd2d11a.ada + cd2d13a.ada + cd30001.a + cd30002.a + cd30003.a + cd30004.a + cd300050.am + cd300051.c + cd3014a.ada + cd3014c.ada + cd3014d.ada + cd3014f.ada + cd3015a.ada + cd3015c.ada + cd3015e.ada + cd3015f.ada + cd3015g.ada + cd3015h.ada + cd3015i.ada + cd3015k.ada + cd3021a.ada + cd33001.a + cd33002.a + cd40001.a + cd4031a.ada + cd4041a.tst + cd4051a.ada + cd4051b.ada + cd4051c.ada + cd4051d.ada + cd5003a.ada + cd5003b.ada + cd5003c.ada + cd5003d.ada + cd5003e.ada + cd5003f.ada + cd5003g.ada + cd5003h.ada + cd5003i.ada + cd5011a.ada + cd5011c.ada + cd5011e.ada + cd5011g.ada + cd5011i.ada + cd5011k.ada + cd5011m.ada + cd5011q.ada + cd5011s.ada + cd5012a.ada + cd5012b.ada + cd5012e.ada + cd5012f.ada + cd5012i.ada + cd5012m.ada + cd5013a.ada + cd5013c.ada + cd5013e.ada + cd5013g.ada + cd5013i.ada + cd5013k.ada + cd5013m.ada + cd5013o.ada + cd5014a.ada + cd5014c.ada + cd5014e.ada + cd5014g.ada + cd5014i.ada + cd5014k.ada + cd5014m.ada + cd5014o.ada + cd5014t.ada + cd5014v.ada + cd5014x.ada + cd5014y.ada + cd5014z.ada + cd70001.a + cd7002a.ada + cd7007b.ada + cd7101d.ada + cd7101e.dep + cd7101f.dep + cd7101g.tst + cd7103d.ada + cd7202a.ada + cd7204b.ada + cd7204c.ada + cd72a01.a + cd72a02.a + cd7305a.ada + cd90001.a + cd92001.a + cda201a.ada + cda201b.ada + cda201c.ada + cda201e.ada + cdb0a01.a + cdb0a02.a + cdd1001.a + cdd2001.a + cde0001.a + ce2102a.ada + ce2102b.ada + ce2102c.tst + ce2102d.ada + ce2102e.ada + ce2102f.ada + ce2102g.ada + ce2102h.tst + ce2102i.ada + ce2102j.ada + ce2102k.ada + ce2102l.ada + ce2102m.ada + ce2102n.ada + ce2102o.ada + ce2102p.ada + ce2102q.ada + ce2102r.ada + ce2102s.ada + ce2102t.ada + ce2102u.ada + ce2102v.ada + ce2102w.ada + ce2102x.ada + ce2102y.ada + ce2103a.tst + ce2103b.tst + ce2103c.ada + ce2103d.ada + ce2104a.ada + ce2104b.ada + ce2104c.ada + ce2104d.ada + ce2106a.ada + ce2106b.ada + ce2108e.ada + ce2108f.ada + ce2108g.ada + ce2108h.ada + ce2109a.ada + ce2109b.ada + ce2109c.ada + ce2110a.ada + ce2110c.ada + ce2111a.ada + ce2111b.ada + ce2111c.ada + ce2111e.ada + ce2111f.ada + ce2111g.ada + ce2111i.ada + ce2201a.ada + ce2201b.ada + ce2201c.ada + ce2201d.dep + ce2201e.dep + ce2201f.ada + ce2201g.ada + ce2201h.ada + ce2201i.ada + ce2201j.ada + ce2201k.ada + ce2201l.ada + ce2201m.ada + ce2201n.ada + ce2202a.ada + ce2203a.tst + ce2204a.ada + ce2204b.ada + ce2204c.ada + ce2204d.ada + ce2205a.ada + ce2206a.ada + ce2208b.ada + ce2401a.ada + ce2401b.ada + ce2401c.ada + ce2401e.ada + ce2401f.ada + ce2401h.ada + ce2401i.ada + ce2401j.ada + ce2401k.ada + ce2401l.ada + ce2402a.ada + ce2403a.tst + ce2404a.ada + ce2404b.ada + ce2405b.ada + ce2406a.ada + ce2407a.ada + ce2407b.ada + ce2408a.ada + ce2408b.ada + ce2409a.ada + ce2409b.ada + ce2410a.ada + ce2410b.ada + ce2411a.ada + ce3002b.tst + ce3002c.tst + ce3002d.ada + ce3002f.ada + ce3102a.ada + ce3102b.tst + ce3102d.ada + ce3102e.ada + ce3102f.ada + ce3102g.ada + ce3102h.ada + ce3102i.ada + ce3102j.ada + ce3102k.ada + ce3103a.ada + ce3104a.ada + ce3104b.ada + ce3104c.ada + ce3106a.ada + ce3106b.ada + ce3107a.tst + ce3107b.ada + ce3108a.ada + ce3108b.ada + ce3110a.ada + ce3112c.ada + ce3112d.ada + ce3114a.ada + ce3115a.ada + ce3201a.ada + ce3202a.ada + ce3206a.ada + ce3207a.ada + ce3301a.ada + ce3302a.ada + ce3303a.ada + ce3304a.tst + ce3305a.ada + ce3306a.ada + ce3401a.ada + ce3402a.ada + ce3402c.ada + ce3402d.ada + ce3402e.ada + ce3403a.ada + ce3403b.ada + ce3403c.ada + ce3403d.ada + ce3403e.ada + ce3403f.ada + ce3404a.ada + ce3404b.ada + ce3404c.ada + ce3404d.ada + ce3405a.ada + ce3405c.ada + ce3405d.ada + ce3406a.ada + ce3406b.ada + ce3406c.ada + ce3406d.ada + ce3407a.ada + ce3407b.ada + ce3407c.ada + ce3408a.ada + ce3408b.ada + ce3408c.ada + ce3409a.ada + ce3409b.ada + ce3409c.ada + ce3409d.ada + ce3409e.ada + ce3410a.ada + ce3410b.ada + ce3410c.ada + ce3410d.ada + ce3410e.ada + ce3411a.ada + ce3411c.ada + ce3412a.ada + ce3413a.ada + ce3413b.ada + ce3413c.ada + ce3414a.ada + ce3601a.ada + ce3602a.ada + ce3602b.ada + ce3602c.ada + ce3602d.ada + ce3603a.ada + ce3604a.ada + ce3604b.ada + ce3605a.ada + ce3605b.ada + ce3605c.ada + ce3605d.ada + ce3605e.ada + ce3606a.ada + ce3606b.ada + ce3701a.ada + ce3704a.ada + ce3704b.ada + ce3704c.ada + ce3704d.ada + ce3704e.ada + ce3704f.ada + ce3704m.ada + ce3704n.ada + ce3704o.ada + ce3705a.ada + ce3705b.ada + ce3705c.ada + ce3705d.ada + ce3705e.ada + ce3706c.ada + ce3706d.ada + ce3706f.ada + ce3706g.ada + ce3707a.ada + ce3708a.ada + ce3801a.ada + ce3801b.ada + ce3804a.ada + ce3804b.ada + ce3804c.ada + ce3804d.ada + ce3804e.ada + ce3804f.ada + ce3804g.ada + ce3804h.ada + ce3804i.ada + ce3804j.ada + ce3804m.ada + ce3804o.ada + ce3804p.ada + ce3805a.ada + ce3805b.ada + ce3806a.ada + ce3806b.ada + ce3806c.ada + ce3806d.ada + ce3806e.ada + ce3806f.ada + ce3806g.ada + ce3806h.ada + ce3809a.ada + ce3809b.ada + ce3810a.ada + ce3810b.ada + ce3815a.ada + ce3901a.ada + ce3902b.ada + ce3904a.ada + ce3904b.ada + ce3905a.ada + ce3905b.ada + ce3905c.ada + ce3905l.ada + ce3906a.ada + ce3906b.ada + ce3906c.ada + ce3906d.ada + ce3906e.ada + ce3906f.ada + ce3907a.ada + ce3908a.ada + checkfil.ada + coverage.txt + cxa3001.a + cxa3002.a + cxa3003.a + cxa3004.a + cxa4001.a + cxa4002.a + cxa4003.a + cxa4004.a + cxa4005.a + cxa4006.a + cxa4007.a + cxa4008.a + cxa4009.a + cxa4010.a + cxa4011.a + cxa4012.a + cxa4013.a + cxa4014.a + cxa4015.a + cxa4016.a + cxa4017.a + cxa4018.a + cxa4019.a + cxa4020.a + cxa4021.a + cxa4022.a + cxa4023.a + cxa4024.a + cxa4025.a + cxa4026.a + cxa4027.a + cxa4028.a + cxa4029.a + cxa4030.a + cxa4031.a + cxa4032.a + cxa4033.a + cxa4034.a + cxa5011.a + cxa5012.a + cxa5013.a + cxa5015.a + cxa5a01.a + cxa5a02.a + cxa5a03.a + cxa5a04.a + cxa5a05.a + cxa5a06.a + cxa5a07.a + cxa5a08.a + cxa5a09.a + cxa5a10.a + cxa8001.a + cxa8002.a + cxa8003.a + cxa9001.a + cxa9002.a + cxaa001.a + cxaa002.a + cxaa003.a + cxaa004.a + cxaa005.a + cxaa006.a + cxaa007.a + cxaa008.a + cxaa009.a + cxaa010.a + cxaa011.a + cxaa012.a + cxaa013.a + cxaa014.a + cxaa015.a + cxaa016.a + cxaa017.a + cxaa018.a + cxaa019.a + cxab001.a + cxac001.a + cxac002.a + cxac003.a + cxac004.a + cxac005.a + cxaca01.a + cxaca02.a + cxacb01.a + cxacb02.a + cxacc01.a + cxaf001.a + cxb2001.a + cxb2002.a + cxb2003.a + cxb3001.a + cxb3002.a + cxb3003.a + cxb30040.c + cxb30041.am + cxb3005.a + cxb30060.c + cxb30061.am + cxb3007.a + cxb3008.a + cxb3009.a + cxb3010.a + cxb3011.a + cxb3012.a + cxb30130.c + cxb30131.c + cxb30132.am + cxb3014.a + cxb3015.a + cxb3016.a + cxb4001.a + cxb4002.a + cxb4003.a + cxb4004.a + cxb4005.a + cxb4006.a + cxb4007.a + cxb4008.a + cxb40090.cbl + cxb40091.cbl + cxb40092.cbl + cxb40093.am + cxb5001.a + cxb5002.a + cxb5003.a + cxb50040.ftn + cxb50041.ftn + cxb50042.am + cxb50050.ftn + cxb50051.ftn + cxb50052.am + cxc3001.a + cxc3002.a + cxc3003.a + cxc3004.a + cxc3005.a + cxc3006.a + cxc3007.a + cxc3008.a + cxc3009.a + cxc6001.a + cxc6002.a + cxc6003.a + cxc7001.a + cxc7002.a + cxc7003.a + cxc7004.a + cxd1001.a + cxd1002.a + cxd1003.a + cxd1004.a + cxd1005.a + cxd1006.a + cxd1007.a + cxd1008.a + cxd2001.a + cxd2002.a + cxd2003.a + cxd2004.a + cxd2006.a + cxd2007.a + cxd2008.a + cxd3001.a + cxd3002.a + cxd3003.a + cxd4001.a + cxd4002.a + cxd4003.a + cxd4004.a + cxd4005.a + cxd4006.a + cxd4007.a + cxd4008.a + cxd4009.a + cxd4010.a + cxd5001.a + cxd6001.a + cxd6002.a + cxd6003.a + cxd8001.a + cxd8002.a + cxd8003.a + cxd9001.a + cxda001.a + cxda002.a + cxda003.a + cxda004.a + cxdb001.a + cxdb002.a + cxdb003.a + cxdb004.a + cxe1001.a + cxe2001.a + cxe2002.a + cxe4001.a + cxe4002.a + cxe4003.a + cxe4004.a + cxe4005.a + cxe4006.a + cxe5001.a + cxe5002.a + cxe5003.a + cxf1001.a + cxf2001.a + cxf2002.a + cxf2003.a + cxf2004.a + cxf2005.a + cxf2a01.a + cxf2a02.a + cxf3001.a + cxf3002.a + cxf3003.a + cxf3004.a + cxf3a01.a + cxf3a02.a + cxf3a03.a + cxf3a04.a + cxf3a05.a + cxf3a06.a + cxf3a07.a + cxf3a08.a + cxg1001.a + cxg1002.a + cxg1003.a + cxg1004.a + cxg1005.a + cxg2001.a + cxg2002.a + cxg2003.a + cxg2004.a + cxg2005.a + cxg2006.a + cxg2007.a + cxg2008.a + cxg2009.a + cxg2010.a + cxg2011.a + cxg2012.a + cxg2013.a + cxg2014.a + cxg2015.a + cxg2016.a + cxg2017.a + cxg2018.a + cxg2019.a + cxg2020.a + cxg2021.a + cxg2022.a + cxg2023.a + cxg2024.a + cxh1001.a + cxh3001.a + cxh3002.a + cxh30030.a + cxh30031.am + cz00004.a + cz1101a.ada + cz1102a.ada + cz1103a.ada + d4a002a.ada + d4a002b.ada + d4a004a.ada + d4a004b.ada + e28002b.ada + e28005d.ada + e52103y.ada + eb4011a.ada + eb4012a.ada + eb4014a.ada + ee3203a.ada + ee3204a.ada + ee3402b.ada + ee3409f.ada + ee3412c.ada + enumchek.ada + f340a000.a + f340a001.a + f341a00.a + f390a00.a + f392a00.a + f392c00.a + f392d00.a + f393a00.a + f393b00.a + f3a2a00.a + f460a00.a + f730a000.a + f730a001.a + f731a00.a + f940a00.a + f954a00.a + fa11a00.a + fa11b00.a + fa11c00.a + fa11d00.a + fa13a00.a + fa13b00.a + fa21a00.a + fb20a00.a + fb40a00.a + fc50a00.a + fc51a00.a + fc51b00.a + fc51c00.a + fc51d00.a + fc54a00.a + fc70a00.a + fc70b00.a + fc70c00.a + fcndecl.ada + fd72a00.a + fdb0a00.a + fxa5a00.a + fxaca00.a + fxacb00.a + fxacc00.a + fxc6a00.a + fxe2a00.a + fxf2a00.a + fxf3a00.a + impdef.a + impdefc.a + impdefd.a + impdefe.a + impdefg.a + impdefh.a + la140010.a + la140011.am + la140012.a + la140020.a + la140021.am + la140022.a + la140030.a + la140031.a + la140032.am + la140033.a + la140040.a + la140041.am + la140042.a + la140050.a + la140051.a + la140052.am + la140053.a + la140060.a + la140061.a + la140062.am + la140063.a + la140070.a + la140071.a + la140072.am + la140073.a + la140080.a + la140081.a + la140082.am + la140083.a + la140090.a + la140091.a + la140092.am + la140093.a + la140100.a + la140101.a + la140102.am + la140103.a + la140110.a + la140111.a + la140112.am + la140113.a + la140120.a + la140121.a + la140122.am + la140123.a + la140130.a + la140131.a + la140132.am + la140133.a + la140140.a + la140141.a + la140142.am + la140143.a + la140150.a + la140151.a + la140152.am + la140153.a + la140160.a + la140161.a + la140162.am + la140163.a + la140170.a + la140171.a + la140172.am + la140173.a + la140180.a + la140181.a + la140182.am + la140183.a + la140190.a + la140191.a + la140192.am + la140193.a + la140200.a + la140201.a + la140202.am + la140203.a + la140210.a + la140211.am + la140212.a + la140220.a + la140221.am + la140222.a + la140240.a + la140241.a + la140242.am + la140243.a + la140250.a + la140251.am + la140252.a + la140260.a + la140261.a + la140262.am + la140263.a + la140270.a + la140271.a + la140272.am + la140273.a + la200010.a + la200011.a + la200012.am + la5001a0.ada + la5001a1.ada + la5001a2.ada + la5001a3.ada + la5001a4.ada + la5001a5.ada + la5001a6.ada + la5001a7.ada + la5007a0.ada + la5007a1.ada + la5007b0.ada + la5007b1.ada + la5007c0.ada + la5007c1.ada + la5007d0.ada + la5007d1.ada + la5007e0.ada + la5007e1.ada + la5007f0.ada + la5007f1.ada + la5007g0.ada + la5007g1.ada + la5008a0.ada + la5008a1.ada + la5008b0.ada + la5008b1.ada + la5008c0.ada + la5008c1.ada + la5008d0.ada + la5008d1.ada + la5008e0.ada + la5008e1.ada + la5008f0.ada + la5008f1.ada + la5008g0.ada + la5008g1.ada + lencheck.ada + lxd70010.a + lxd70011.a + lxd70012.am + lxd70030.a + lxd70031.a + lxd70032.am + lxd70040.a + lxd70041.a + lxd70042.am + lxd70050.a + lxd70051.a + lxd70052.am + lxd70060.a + lxd70061.a + lxd70062.am + lxd70070.a + lxd70071.a + lxd70072.am + lxd70080.a + lxd70081.a + lxd70082.am + lxd70090.a + lxd70091.a + lxd70092.am + lxe30010.am + lxe30011.am + lxe30020.am + lxe30021.am + lxh40010.a + lxh40011.a + lxh40012.am + lxh40020.a + lxh40021.a + lxh40022.am + lxh40030.a + lxh40031.a + lxh40032.a + lxh40033.am + lxh40040.a + lxh40041.a + lxh40042.a + lxh40043.am + lxh40050.a + lxh40051.a + lxh40052.a + lxh40053.am + lxh40060.a + lxh40061.a + lxh40062.a + lxh40063.am + lxh40070.a + lxh40071.a + lxh40072.a + lxh40073.am + lxh40080.a + lxh40081.a + lxh40082.a + lxh40083.a + lxh40084.am + lxh40090.a + lxh40091.a + lxh40092.a + lxh40093.am + lxh40100.a + lxh40101.a + lxh40102.a + lxh40103.am + lxh40110.a + lxh40111.a + lxh40112.am + lxh40120.a + lxh40121.a + lxh40122.a + lxh40123.am + lxh40130.a + lxh40131.a + lxh40132.a + lxh40133.am + lxh40140.a + lxh40141.a + lxh40142.am + macro.dfs + macrosub.ada + repbody.ada + repspec.ada + spprt13s.tst + tctouch.ada + testobj.txt + tsttests.dat + ug-apxa.doc + ug-apxa.pdf + ug-apxa.txt + ug-apxb.doc + ug-apxb.pdf + ug-apxb.txt + ug-apxc.doc + ug-apxc.pdf + ug-apxc.txt + ug-apxd.doc + ug-apxd.pdf + ug-apxd.txt + ug-body.doc + ug-body.pdf + ug-body.txt + widechr.a diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/checkfil.ada gcc-3.4.0/gcc/testsuite/ada/acats/support/checkfil.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/support/checkfil.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/checkfil.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,197 ---- + -- CHECK_FILE.ADA + -- + -- 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. + --* + -- + -- THIS IS A PROCEDURE USED BY MANY OF THE CHAPTER 14 TESTS TO CHECK THE + -- CONTENTS OF A TEXT FILE. + + -- THIS PROCEDURE ASSUMES THE FILE PARAMETER PASSED TO IT IS AN OPEN + -- TEXT FILE. + + -- THE STRING PARAMETER CONTAINS THE CHARACTERS THAT ARE SUPPOSED TO BE + -- IN THE TEXT FILE. A '#' CHARACTER IS USED IN THE STRING TO DENOTE + -- THE END OF A LINE. A '@' CHARACTER IS USED TO DENOTE THE END OF A + -- PAGE. A '%' CHARACTER IS USED TO DENOTE THE END OF THE TEXT FILE. + -- THESE SYMBOLS SHOULD NOT BE USED AS TEXT OUTPUT. + + -- SPS 11/30/82 + -- JBG 2/3/83 + + WITH REPORT; USE REPORT; + WITH TEXT_IO; USE TEXT_IO; + + PROCEDURE CHECK_FILE (FILE: IN OUT FILE_TYPE; CONTENTS : STRING) IS + + X : CHARACTER; + COL_COUNT : POSITIVE_COUNT := 1; + LINE_COUNT : POSITIVE_COUNT := 1; + PAGE_COUNT : POSITIVE_COUNT := 1; + TRAILING_BLANKS_MSG_WRITTEN : BOOLEAN := FALSE; + STOP_PROCESSING : EXCEPTION; + + PROCEDURE CHECK_END_OF_LINE (EXPECT_END_OF_PAGE : BOOLEAN) IS + BEGIN + + -- SKIP OVER ANY TRAILING BLANKS. AN IMPLEMENTATION CAN LEGALLY + -- APPEND BLANKS TO THE END OF ANY LINE. + + WHILE NOT END_OF_LINE (FILE) LOOP + GET (FILE, X); + IF X /= ' ' THEN + FAILED ("FROM CHECK_FILE: END OF LINE EXPECTED - " & + X & " ENCOUNTERED"); + RAISE STOP_PROCESSING; + ELSE + IF NOT TRAILING_BLANKS_MSG_WRITTEN THEN + COMMENT ("FROM CHECK_FILE: " & + "THIS IMPLEMENTATION PADS " & + "LINES WITH BLANKS"); + TRAILING_BLANKS_MSG_WRITTEN := TRUE; + END IF; + END IF; + END LOOP; + + IF LINE_COUNT /= LINE (FILE) THEN + FAILED ("FROM CHECK_FILE: " & + "LINE COUNT INCORRECT - EXPECTED " & + POSITIVE_COUNT'IMAGE(LINE_COUNT) & + " GOT FROM FILE " & + POSITIVE_COUNT'IMAGE(LINE(FILE))); + END IF; + + -- NOTE: DO NOT SKIP_LINE WHEN AT END OF PAGE BECAUSE SKIP_LINE WILL + -- ALSO SKIP THE PAGE TERMINATOR. SEE RM 14.3.5 PARAGRAPH 1. + + IF NOT EXPECT_END_OF_PAGE THEN + IF END_OF_PAGE (FILE) THEN + FAILED ("FROM CHECK_FILE: PREMATURE END OF PAGE"); + RAISE STOP_PROCESSING; + ELSE + SKIP_LINE (FILE); + LINE_COUNT := LINE_COUNT + 1; + END IF; + END IF; + COL_COUNT := 1; + END CHECK_END_OF_LINE; + + PROCEDURE CHECK_END_OF_PAGE IS + BEGIN + IF NOT END_OF_PAGE (FILE) THEN + FAILED ("FROM CHECK_FILE: " & + "END_OF_PAGE NOT WHERE EXPECTED"); + RAISE STOP_PROCESSING; + ELSE + IF PAGE_COUNT /= PAGE (FILE) THEN + FAILED ("FROM CHECK_FILE: " & + "PAGE COUNT INCORRECT - EXPECTED " & + POSITIVE_COUNT'IMAGE (PAGE_COUNT) & + " GOT FROM FILE " & + POSITIVE_COUNT'IMAGE (PAGE(FILE))); + END IF; + + SKIP_PAGE (FILE); + PAGE_COUNT := PAGE_COUNT + 1; + LINE_COUNT := 1; + END IF; + END CHECK_END_OF_PAGE; + + BEGIN + + RESET (FILE, IN_FILE); + SET_LINE_LENGTH (STANDARD_OUTPUT, 0); + SET_PAGE_LENGTH (STANDARD_OUTPUT, 0); + + FOR I IN 1 .. CONTENTS'LENGTH LOOP + + BEGIN + CASE CONTENTS (I) IS + WHEN '#' => + CHECK_END_OF_LINE (CONTENTS (I + 1) = '@'); + WHEN '@' => + CHECK_END_OF_PAGE; + WHEN '%' => + IF NOT END_OF_FILE (FILE) THEN + FAILED ("FROM CHECK_FILE: " & + "END_OF_FILE NOT WHERE EXPECTED"); + RAISE STOP_PROCESSING; + END IF; + WHEN OTHERS => + IF COL_COUNT /= COL(FILE) THEN + FAILED ("FROM CHECK_FILE: " & + "COL COUNT INCORRECT - " & + "EXPECTED " & POSITIVE_COUNT' + IMAGE(COL_COUNT) & " GOT FROM " & + "FILE " & POSITIVE_COUNT'IMAGE + (COL(FILE))); + END IF; + GET (FILE, X); + COL_COUNT := COL_COUNT + 1; + IF X /= CONTENTS (I) THEN + FAILED("FROM CHECK_FILE: " & + "FILE DOES NOT CONTAIN CORRECT " & + "OUTPUT - EXPECTED " & CONTENTS(I) + & " - GOT " & X); + RAISE STOP_PROCESSING; + END IF; + END CASE; + EXCEPTION + WHEN STOP_PROCESSING => + COMMENT ("FROM CHECK_FILE: " & + "LAST CHARACTER IN FOLLOWING STRING " & + "REVEALED ERROR: " & CONTENTS (1 .. I)); + EXIT; + END; + + END LOOP; + + EXCEPTION + WHEN STATUS_ERROR => + FAILED ("FROM CHECK_FILE: " & + "STATUS_ERROR RAISED - FILE CHECKING INCOMPLETE"); + WHEN MODE_ERROR => + FAILED ("FROM CHECK_FILE: " & + "MODE_ERROR RAISED - FILE CHECKING INCOMPLETE"); + WHEN NAME_ERROR => + FAILED ("FROM CHECK_FILE: " & + "NAME_ERROR RAISED - FILE CHECKING INCOMPLETE"); + WHEN USE_ERROR => + FAILED ("FROM CHECK_FILE: " & + "USE_ERROR RAISED - FILE CHECKING INCOMPLETE"); + WHEN DEVICE_ERROR => + FAILED ("FROM CHECK_FILE: " & + "DEVICE_ERROR RAISED - FILE CHECKING INCOMPLETE"); + WHEN END_ERROR => + FAILED ("FROM CHECK_FILE: " & + "END_ERROR RAISED - FILE CHECKING INCOMPLETE"); + WHEN DATA_ERROR => + FAILED ("FROM CHECK_FILE: " & + "DATA_ERROR RAISED - FILE CHECKING INCOMPLETE"); + WHEN LAYOUT_ERROR => + FAILED ("FROM CHECK_FILE: " & + "LAYOUT_ERROR RAISED - FILE CHECKING INCOMPLETE"); + WHEN OTHERS => + FAILED ("FROM CHECK_FILE: " & + "SOME EXCEPTION RAISED - FILE CHECKING INCOMPLETE"); + + END CHECK_FILE; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/enumchek.ada gcc-3.4.0/gcc/testsuite/ada/acats/support/enumchek.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/support/enumchek.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/enumchek.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,65 ---- + -- THIS GENERIC PROCEDURE IS INTENDED FOR USE IN CONJUNCTION WITH THE ACVC + -- CHAPTER 13 C TESTS. IT IS INSTANTIATED WITH TWO TYPES. THE FIRST IS AN + -- ENUMERATION TYPE FOR WHICH AN ENUMERATION CLAUSE HAS BEEN GIVEN, AND THE + -- SECOND IS AN INTEGER TYPE WHOSE 'SIZE IS THE SAME AS THE 'SIZE OF THIS + -- ENUMERATION TYPE. + + -- THE PROCEDURE ENUM_CHECK IS THEN CALLED WITH THREE ARGUMENTS. THE FIRST IS + -- AN ENUMERATION LITERAL FROM THE ENUMERATION TYPE, THE SECOND IS AN INTEGER + -- LITERAL WHICH IS THE VALUE OF THE EXPECTED REPRESENTATION (TAKEN FROM THE + -- ENUMERATION REPRESENTATION CLAUSE), AND THE THIRD IS A STRING DESCRIBING OR + -- NAMING THE TYPE (USED IN A CALL TO FAILED IF THE REPRESENTATION CHECK FAILS). + + -- THE CHECK IS TO CONVERT THE ENUMERATION VALUE TO A BOOLEAN ARRAY WITH A + -- LENGTH CORRESONDING TO THE 'SIZE OF THE ENUMERATION TYPE. AN INTEGER TYPE + -- IS THEN CREATED WITH THIS SAME 'SIZE, AND THE REQUIRED REPRESENTATION VALUE + -- IS CONVERTED FROM THIS TYPE TO A BOOLEAN ARRAY WITH THE SAME LENGTH. THE + -- TWO BOOLEAN ARRAYS ARE THEN COMPARED AND SHOULD BE EQUAL. THE CONVERSIONS + -- ARE PERFORMED USING APPROPRIATE INSTANTIATIONS OF UNCHECKED_CONVERSION. + + -- AUTHOR: ROBERT B. K. DEWAR, UNCOPYRIGHTED, PUBLIC DOMAIN USE AUTHORIZED + + GENERIC + + TYPE ENUM_TYPE IS PRIVATE; + TYPE INT_TYPE IS RANGE <>; + + PROCEDURE ENUM_CHECK (TEST_VALUE : ENUM_TYPE; + REP_VALUE : INT_TYPE; + TYPE_ID : STRING); + + + WITH UNCHECKED_CONVERSION; + WITH REPORT; USE REPORT; + + PROCEDURE ENUM_CHECK (TEST_VALUE : ENUM_TYPE; + REP_VALUE : INT_TYPE; + TYPE_ID : STRING) IS + + TYPE BIT_ARRAY_TYPE IS ARRAY (1 .. ENUM_TYPE'SIZE) OF BOOLEAN; + PRAGMA PACK (BIT_ARRAY_TYPE); + + FUNCTION TO_BITS IS NEW UNCHECKED_CONVERSION (ENUM_TYPE, BIT_ARRAY_TYPE); + FUNCTION TO_BITS IS NEW UNCHECKED_CONVERSION (INT_TYPE, BIT_ARRAY_TYPE); + + BIT_ARRAY_1 : BIT_ARRAY_TYPE; + BIT_ARRAY_2 : BIT_ARRAY_TYPE; + + INT_VALUE : INT_TYPE := INT_TYPE (REP_VALUE); + + BEGIN + + -- VERIFY CORRECT CALL (THIS IS A SANITY CHECK ON THE TEST ITSELF) + + IF ENUM_TYPE'SIZE /= INT_TYPE'SIZE THEN + FAILED ("ERROR IN ENUM_CHECK CALL: SIZES DO NOT MATCH"); + END IF; + + BIT_ARRAY_1 := TO_BITS (TEST_VALUE); + BIT_ARRAY_2 := TO_BITS (INT_VALUE); + + IF BIT_ARRAY_1 /= BIT_ARRAY_2 THEN + FAILED ("CHECK ON REPRESENTATION OF TYPE " & TYPE_ID & " FAILED."); + END IF; + + END ENUM_CHECK; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f340a000.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f340a000.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f340a000.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f340a000.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,149 ---- + -- F340A000.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This file simulates a generic linked list abstraction for use in tests + -- covering tagged types and type extensions. + -- + -- TEST FILES: + -- This foundation consists of the following files: + -- + -- => F340A000.A + -- F340A001.A + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- 12 Jun 96 SAIC ACVC 2.1: Modified prologue. Added pragma + -- Elaborate_Body. + -- + --! + + generic -- Singly-linked list abstraction. + type Parent_Type is tagged private; -- Actual is parent + package F340A000 is -- tagged type. + + pragma Elaborate_Body; + + + -- Declarations for visible linked list nodes: + + type Node_Type; + + type Node_Ptr is access Node_Type; + + type Node_Type is new Parent_Type with record -- Record extension + Next : Node_Ptr := null; -- of parent type. + end record; + + + -- Inherits primitive operations of actual type corresponding + -- to Parent_Type. + + -- Add node at head of list. + procedure Add (Item : in Node_Ptr; + Head : in out Node_Ptr); + + -- Remove node from head of list and return it. + procedure Remove (Head : in out Node_Ptr; + Item : out Node_Ptr); + + + + -- Declarations for private linked list nodes: + + type Priv_Node_Type is new Parent_Type with private; -- Private extension + -- of parent type. + + -- Inherits primitive operations of actual parameter corresponding + -- to Parent_Type. + + + type Priv_Node_Ptr is access Priv_Node_Type; + + + -- Add node at head of list. + procedure Add (Item : in Priv_Node_Ptr; + Head : in out Priv_Node_Ptr); + + -- Remove node from head of list and return it. + procedure Remove (Head : in out Priv_Node_Ptr; + Item : out Priv_Node_Ptr); + + + private + + type Priv_Node_Type is new Parent_Type with record + Next : Priv_Node_Ptr := null; + end record; + + end F340A000; + + + --==================================================================-- + + + package body F340A000 is -- Singly-linked list abstraction. + + procedure Add (Item : in Node_Ptr; + Head : in out Node_Ptr) is + begin + if Item /= null then + Item.Next := Head; + Head := Item; + end if; + end Add; + + + procedure Remove (Head : in out Node_Ptr; + Item : out Node_Ptr) is + begin + Item := Head; + if Head /= null then + Head := Head.Next; + end if; + end Remove; + + + procedure Add (Item : in Priv_Node_Ptr; + Head : in out Priv_Node_Ptr) is + begin + if Item /= null then + Item.Next := Head; + Head := Item; + end if; + end Add; + + + procedure Remove (Head : in out Priv_Node_Ptr; + Item : out Priv_Node_Ptr) is + begin + Item := Head; + if Head /= null then + Head := Head.Next; + end if; + end Remove; + + + end F340A000; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f340a001.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f340a001.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f340a001.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f340a001.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,75 ---- + -- F340A001.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This file declares a tagged type and primitive subprogram for use in + -- tests covering tagged types and type extensions. + -- + -- TEST FILES: + -- The following files comprise this foundation: + -- + -- F340A000.A + -- => F340A001.A + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package F340A001 is -- Book definitions. + + + type Text_Ptr is access String; + + type Book_Type is tagged record -- Root tagged type. + Title : Text_Ptr; + Author : Text_Ptr; + end record; + + + procedure Create_Book (Title : in Text_Ptr; -- Primitive operation + Author : in Text_Ptr; -- of root tagged type. + Book : out Book_Type); + + + end F340A001; + + + --==================================================================-- + + + package body F340A001 is -- Book definitions. + + + procedure Create_Book (Title : in Text_Ptr; + Author : in Text_Ptr; + Book : out Book_Type) is + begin + Book.Title := Title; + Book.Author := Author; + end Create_Book; + + + end F340A001; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f341a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f341a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f341a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f341a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,216 ---- + -- F341A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation provides a simple class hierarchy (a root type and two + -- levels of derivation from it) to use in testing the basic OO features + -- related to tagged types. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package F341A00_0 is -- package Bank + + type Dollar_Amount is new Float; + + type Account is tagged + record + Current_Balance: Dollar_Amount; + end record; + + -- Primitive operations. + + procedure Deposit (A : in out Account; + X : in Dollar_Amount); + procedure Withdrawal (A : in out Account; + X : in Dollar_Amount); + function Balance (A : in Account) return Dollar_Amount; + procedure Service_Charge (A : in out Account); + procedure Add_Interest (A : in out Account); + procedure Open (A : in out Account); + + end F341A00_0; + + + --=================================================================-- + + + package body F341A00_0 is + + -- Primitive operations for type Account. + + procedure Deposit (A : in out Account; + X : in Dollar_Amount) is + begin + A.Current_Balance := A.Current_Balance + X; + end Deposit; + + -- + + procedure Withdrawal (A : in out Account; + X : in Dollar_Amount) is + begin + A.Current_Balance := A.Current_Balance - X; + end Withdrawal; + + -- + + function Balance (A : in Account) return Dollar_Amount is + begin + return (A.Current_Balance); + end Balance; + + -- + + procedure Service_Charge (A : in out Account) is + begin + A.Current_Balance := A.Current_Balance - 5.00; + end Service_Charge; + + -- + + procedure Add_Interest (A : in out Account) is + -- No interest accumulated on this type of account. + Interest_On_Account : Dollar_Amount := 0.00; + begin + A.Current_Balance := A.Current_Balance + Interest_On_Account; + end Add_Interest; + + -- + + procedure Open (A : in out Account) is + Initial_Deposit : Dollar_Amount := 10.00; + begin + A.Current_Balance := Initial_Deposit; + end Open; + + end F341A00_0; + + + --=================================================================-- + + + with F341A00_0; + + package F341A00_1 is -- package Checking + + package Bank renames F341A00_0; + + type Account is new Bank.Account with + record + Overdraft_Fee : Bank.Dollar_Amount; + end record; + + + -- Inherited primitive operations. + -- procedure Deposit (A : in out Account; X : in Bank.Dollar_Amount); + -- procedure Withdrawal (A : in out Account; X : in Bank.Dollar_Amount); + -- function Balance (A : in Account) return Bank.Dollar_Amount; + -- procedure Service_Charge(A : in out Account); + -- procedure Add_Interest (A : in out Account); + + -- Overridden primitive operation. + procedure Open (A : in out Account); + + end F341A00_1; + + + --=================================================================-- + + + package body F341A00_1 is + + -- Overridden primitive operation. + + procedure Open (A : in out Account) is + Check_Guarantee : Bank.Dollar_Amount := 10.00; + Initial_Deposit : Bank.Dollar_Amount := 100.00; + begin + A.Current_Balance := Initial_Deposit; + A.Overdraft_Fee := Check_Guarantee; + end Open; + + end F341A00_1; + + + --=================================================================-- + + + with F341A00_0; -- package Bank + with F341A00_1; -- package Checking + + package F341A00_2 is -- package Interest_Checking + + package Bank renames F341A00_0; + package Checking renames F341A00_1; + + subtype Interest_Rate is Bank.Dollar_Amount digits 4; + + Current_Rate : Interest_Rate := 0.030; + + type Account is new Checking.Account with + record + Rate : Interest_Rate; + end record; + + -- "Twice" inherited primitive operations (Bank.Account, Checking.Account) + -- procedure Deposit (A : in out Account; X : in Bank.Dollar_Amount); + -- procedure Withdrawal (A : in out Account; X : in Bank.Dollar_Amount); + -- function Balance (A : in Account) return Bank.Dollar_Amount; + -- procedure Service_Charge(A : in out Account); + + -- Overridden primitive operations. + procedure Add_Interest (A : in out Account); + procedure Open (A : in out Account); + + end F341A00_2; + + + --=================================================================-- + + + package body F341A00_2 is + + -- Overridden primitive operations. + + procedure Add_Interest (A : in out Account) is + use type Bank.Dollar_Amount; + Interest_On_Account : Bank.Dollar_Amount + := Bank.Dollar_Amount(A.Current_Balance * A.Rate); + begin + A.Current_Balance := A.Current_Balance + Interest_On_Account; + end Add_Interest; + + procedure Open (A : in out Account) is + Initial_Deposit : Bank.Dollar_Amount := 1000.00; + begin + Checking.Open (Checking.Account (A)); + A.Current_Balance := Initial_Deposit; + A.Rate := Current_Rate; + end Open; + + end F341A00_2; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f390a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f390a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f390a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f390a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,94 ---- + -- F390A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This file declares the root type and primitive subprograms of an + -- alert system abstraction, to be used for tests covering tagged + -- types and type extensions. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- 04 Jun 96 SAIC ACVC 2.1: Added pragma Elaborate for Ada.Calendar. + -- + --! + + with Ada.Calendar; + pragma Elaborate (Ada.Calendar); + + package F390A00 is -- Alert system abstraction. + + + -- Declarations used by component Display_On and procedure Display. + + type Device_Enum is (Null_Device, Teletype, Console, Big_Screen); + type Display_Counters is array (Device_Enum) of Natural; + + Display_Count_For : Display_Counters := (others => 0); + + + -- Declarations used by component Arrival_Time. + + Default_Time : constant Ada.Calendar.Time := + Ada.Calendar.Time_Of (1901, 1, 1); + Alert_Time : constant Ada.Calendar.Time := + Ada.Calendar.Time_Of (1991, 6, 15); + + + + type Alert_Type is tagged record -- Root tagged type. + Arrival_Time : Ada.Calendar.Time := Default_Time; + Display_On : Device_Enum := Null_Device; + end record; + + + procedure Display (A : in Alert_Type); -- To be inherited by + -- all derivatives. + + procedure Handle (A : in out Alert_Type); -- To be overridden by + -- all derivatives. + + end F390A00; + + + --==================================================================-- + + + package body F390A00 is -- Alert system abstraction. + + + procedure Display (A : in Alert_Type) is + begin + Display_Count_For (A.Display_On) := Display_Count_For (A.Display_On) + 1; + end Display; + + + procedure Handle (A : in out Alert_Type) is + begin + A.Arrival_Time := Alert_Time; + Display (A); + end Handle; + + + end F390A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f392a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f392a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f392a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f392a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,200 ---- + -- F392A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation provides a basis for tests needing a hierarchy of + -- types to check object-oriented features. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package F392A00 is -- package Accounts + + -- + -- Types and subtypes. + -- + + type Dollar_Amount is new Float; + type Interest_Rate is delta 0.001 range 0.000 .. 1.000; + type Account_Types is (Bank, Savings, Preferred, Total); + type Account_Counter is array (Account_Types) of Integer; + type Account_Rep is (President, Manager, New_Account_Manager, Teller); + + -- + -- Constants. + -- + + Opening_Balance : constant Dollar_Amount := 100.00; + Current_Rate : constant Interest_Rate := 0.030; + Preferred_Minimum_Balance : constant Dollar_Amount := 1000.00; + + -- + -- Global Variables + -- + + Bank_Reserve : Dollar_Amount := 0.00; + Daily_Representative : Account_Rep := New_Account_Manager; + Number_Of_Accounts : Account_Counter := (Bank => 0, + Savings => 0, + Preferred => 0, + Total => 0); + -- + -- Account types and their primitive operations. + -- + + -- Root type. + + type Bank_Account is tagged + record + Balance : Dollar_Amount; + end record; + + -- Primitive operations of Bank_Account. + + procedure Increment_Bank_Reserve (Acct : in Bank_Account); + procedure Assign_Representative (Acct : in Bank_Account); + procedure Increment_Counters (Acct : in Bank_Account); + procedure Open (Acct : in out Bank_Account); + + -- + + type Savings_Account is new Bank_Account with + record + Rate : Interest_Rate; + end record; + + -- Procedure Increment_Bank_Reserve inherited from parent (Bank_Account). + + -- Primitive operations (Overridden). + procedure Assign_Representative (Acct : in Savings_Account); + procedure Increment_Counters (Acct : in Savings_Account); + procedure Open (Acct : in out Savings_Account); + + -- + + type Preferred_Account is new Savings_Account with + record + Minimum_Balance : Dollar_Amount; + end record; + + -- Procedure Increment_Bank_Reserve inherited twice. + -- Procedure Assign_Representative inherited from parent (Savings_Account). + + -- Primitive operations (Overridden). + procedure Increment_Counters (Acct : in Preferred_Account); + procedure Open (Acct : in out Preferred_Account); + + -- Function used to verify Open operation for Preferred_Account objects. + function Verify_Open (Acct : in Preferred_Account) return Boolean; + + + end F392A00; + + + --=================================================================-- + + + package body F392A00 is + + -- + -- Primitive operations for Bank_Account. + -- + + procedure Increment_Bank_Reserve (Acct : in Bank_Account) is + begin + Bank_Reserve := Bank_Reserve + Acct.Balance; + end Increment_Bank_Reserve; + + procedure Assign_Representative (Acct : in Bank_Account) is + begin + Daily_Representative := Teller; + end Assign_Representative; + + procedure Increment_Counters (Acct : in Bank_Account) is + begin + Number_Of_Accounts (Bank) := Number_Of_Accounts (Bank) + 1; + Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1; + end Increment_Counters; + + procedure Open (Acct : in out Bank_Account) is + begin + Acct.Balance := Opening_Balance; + end Open; + + + -- + -- Overridden operations for Savings_Account type. + -- + + procedure Assign_Representative (Acct : in Savings_Account) is + begin + Daily_Representative := Manager; + end Assign_Representative; + + procedure Increment_Counters (Acct : in Savings_Account) is + begin + Number_Of_Accounts (Savings) := Number_Of_Accounts (Savings) + 1; + Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1; + end Increment_Counters; + + procedure Open (Acct : in out Savings_Account) is + begin + Open (Bank_Account(Acct)); + Acct.Rate := Current_Rate; + Acct.Balance := 2.0 * Opening_Balance; + end Open; + + + -- + -- Overridden operation for Preferred_Account type. + -- + + procedure Increment_Counters (Acct : in Preferred_Account) is + begin + Number_Of_Accounts (Preferred) := Number_Of_Accounts (Preferred) + 1; + Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1; + end Increment_Counters; + + procedure Open (Acct : in out Preferred_Account) is + begin + Open (Savings_Account(Acct)); + Acct.Minimum_Balance := Preferred_Minimum_Balance; + Acct.Balance := Acct.Minimum_Balance; + end Open; + + -- + -- Function used to verify Open operation for Preferred_Account objects. + -- + + function Verify_Open (Acct : in Preferred_Account) return Boolean is + begin + return (Acct.Balance = Preferred_Minimum_Balance and + Acct.Rate = Current_Rate and + Acct.Minimum_Balance = Preferred_Minimum_Balance); + end Verify_Open; + + end F392A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f392c00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f392c00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f392c00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f392c00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,267 ---- + -- F392C00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation provides a basis for tagged type and dispatching + -- tests. Each test describes the utilizations. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- 24 OCT 95 SAIC Updated for ACVC 2.0.1 + -- + --! + + package F392C00_1 is -- Switches + + type Toggle is tagged private; ---------------------------------- Toggle + + function Create return Toggle; + procedure Flip ( It : in out Toggle ); + function On ( It : Toggle'Class ) return Boolean; + function Off ( It : Toggle'Class ) return Boolean; + + type Dimmer is new Toggle with private; ------------------------- Dimmer + + type Luminance is range 0..100; + + function Create return Dimmer; + procedure Flip ( It : in out Dimmer ); + procedure Brighten( It : in out Dimmer; + By : in Luminance := 10 ); + procedure Dim ( It : in out Dimmer; + By : in Luminance := 10 ); + function Intensity( It : Dimmer ) return Luminance; + + type Auto_Dimmer is new Dimmer with private; --------------- Auto_Dimmer + + function Create return Auto_Dimmer; + procedure Flip ( It: in out Auto_Dimmer ); + procedure Set_Auto ( It: in out Auto_Dimmer ); + procedure Clear_Auto( It: in out Auto_Dimmer ); + -- procedure Set_Manual( It: in out Auto_Dimmer ) renames Clear_Auto; + procedure Set_Cutin ( It: in out Auto_Dimmer; Lumens: in Luminance ); + procedure Set_Cutout( It: in out Auto_Dimmer; Lumens: in Luminance ); + + function Auto ( It: Auto_Dimmer ) return Boolean; + function Cutout_Threshold( It: Auto_Dimmer ) return Luminance; + function Cutin_Threshold ( It: Auto_Dimmer ) return Luminance; + + function TC_CW_TI( Key : Character ) return Toggle'Class; + + function TC_Non_Disp( It: Toggle ) return Boolean; + function TC_Non_Disp( It: Dimmer ) return Boolean; + function TC_Non_Disp( It: Auto_Dimmer ) return Boolean; + + private + + type Toggle is tagged record + On : Boolean := False; + end record; + + type Dimmer is new Toggle with record + Intensity : Luminance := 100; + end record; + + type Auto_Dimmer is new Dimmer with record + Cutout_Threshold : Luminance := 60; + Cutin_Threshold : Luminance := 40; + Auto_Engaged : Boolean := False; + end record; + + end F392C00_1; + + with TCTouch; + package body F392C00_1 is + + function Create return Toggle is + begin + TCTouch.Touch( '1' ); ------------------------------------------------ 1 + return Toggle'( On => True ); + end Create; + + function Create return Dimmer is + begin + TCTouch.Touch( '2' ); ------------------------------------------------ 2 + return Dimmer'( On => True, Intensity => 75 ); + end Create; + + function Create return Auto_Dimmer is + begin + TCTouch.Touch( '3' ); ------------------------------------------------ 3 + return Auto_Dimmer'( On => True, Intensity => 25, + Cutout_Threshold | Cutin_Threshold => 50, + Auto_Engaged => True ); + end Create; + + procedure Flip ( It : in out Toggle ) is + begin + TCTouch.Touch( 'A' ); ------------------------------------------------ A + It.On := not It.On; + end Flip; + + function On( It : Toggle'Class ) return Boolean is + begin + TCTouch.Touch( 'B' ); ------------------------------------------------ B + return It.On; + end On; + + function Off( It : Toggle'Class ) return Boolean is + begin + TCTouch.Touch( 'C' ); ------------------------------------------------ C + return not It.On; + end Off; + + procedure Brighten( It : in out Dimmer; + By : in Luminance := 10 ) is + begin + TCTouch.Touch( 'D' ); ------------------------------------------------ D + if (It.Intensity+By) <= Luminance'Last then + It.Intensity := It.Intensity+By; + else + It.Intensity := Luminance'Last; + end if; + end Brighten; + + procedure Dim ( It : in out Dimmer; + By : in Luminance := 10 ) is + begin + TCTouch.Touch( 'E' ); ------------------------------------------------ E + if (It.Intensity-By) >= Luminance'First then + It.Intensity := It.Intensity-By; + else + It.Intensity := Luminance'First; + end if; + end Dim; + + function Intensity( It : Dimmer ) return Luminance is + begin + TCTouch.Touch( 'F' ); ------------------------------------------------ F + if On(It) then + return It.Intensity; + else + return Luminance'First; + end if; + end Intensity; + + procedure Flip ( It : in out Dimmer ) is + begin + TCTouch.Touch( 'G' ); ------------------------------------------------ G + if On( It ) and (It.Intensity < 50) then + It.Intensity := Luminance'Last - It.Intensity; + else + Flip( Toggle( It ) ); + end if; + end Flip; + + procedure Set_Auto ( It: in out Auto_Dimmer ) is + begin + TCTouch.Touch( 'H' ); ------------------------------------------------ H + It.Auto_Engaged := True; + end Set_Auto; + + procedure Clear_Auto( It: in out Auto_Dimmer ) is + begin + TCTouch.Touch( 'I' ); ------------------------------------------------ I + It.Auto_Engaged := False; + end Clear_Auto; + + function Auto ( It: Auto_Dimmer ) return Boolean is + begin + TCTouch.Touch( 'J' ); ------------------------------------------------ J + return It.Auto_Engaged; + end Auto; + + procedure Flip ( It: in out Auto_Dimmer ) is + begin + TCTouch.Touch( 'K' ); ------------------------------------------------ K + if It.Auto_Engaged then + if Off(It) then + Flip( Dimmer( It ) ); + else + It.Auto_Engaged := False; + end if; + else + Flip( Dimmer( It ) ); + end if; + end Flip; + + procedure Set_Cutin ( It : in out Auto_Dimmer; + Lumens : in Luminance) is + begin + TCTouch.Touch( 'L' ); ------------------------------------------------ L + It.Cutin_Threshold := Lumens; + end Set_Cutin; + + procedure Set_Cutout( It : in out Auto_Dimmer; + Lumens : in Luminance) is + begin + TCTouch.Touch( 'M' ); ------------------------------------------------ M + It.Cutout_Threshold := Lumens; + end Set_Cutout; + + function Cutout_Threshold( It : Auto_Dimmer ) return Luminance is + begin + TCTouch.Touch( 'N' ); ------------------------------------------------ N + return It.Cutout_Threshold; + end Cutout_Threshold; + + function Cutin_Threshold ( It : Auto_Dimmer ) return Luminance is + begin + TCTouch.Touch( 'O' ); ------------------------------------------------ O + return It.Cutin_Threshold; + end Cutin_Threshold; + + function TC_CW_TI( Key : Character ) return Toggle'Class is + begin + TCTouch.Touch( 'W' ); ------------------------------------------------ W + case Key is + when 'T' | 't' => return Toggle'( On => True ); + when 'D' | 'd' => return Dimmer'( On => True, Intensity => 75 ); + when 'A' | 'a' => return Auto_Dimmer'( On => True, Intensity => 25, + Cutout_Threshold | Cutin_Threshold => 50, + Auto_Engaged => True ); + when others => null; + end case; + end TC_CW_TI; + + function TC_Non_Disp( It: Toggle ) return Boolean is + begin + TCTouch.Touch( 'X' ); ------------------------------------------------ X + return It.On; + end TC_Non_Disp; + + function TC_Non_Disp( It: Dimmer ) return Boolean is + begin + TCTouch.Touch( 'Y' ); ------------------------------------------------ Y + return It.On; + end TC_Non_Disp; + + function TC_Non_Disp( It: Auto_Dimmer ) return Boolean is + begin + TCTouch.Touch( 'Z' ); ------------------------------------------------ Z + return It.On; + end TC_Non_Disp; + + end F392C00_1; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f392d00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f392d00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f392d00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f392d00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,103 ---- + -- F392D00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares parent tagged types and subprograms for use + -- in tests covering dispatching operations. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package F392D00 is + + type Depth_Of_Field is range 5 .. 100; + type Shutter_Speed is (One, Two_Fifty, Four_Hundred, Thousand); + + type Remote_Camera is tagged record + DOF : Depth_Of_Field := 10; + Shutter: Shutter_Speed := One; + end record; + + -- ...Other declarations. + + procedure Focus (C : in out Remote_Camera; + Depth : in Depth_Of_Field); + + procedure Self_Test (C: in out Remote_Camera'Class); + + -- ...Other operations. + + private + + procedure Set_Shutter_Speed (C : in out Remote_Camera; + Speed : in Shutter_Speed); + + -- For the basic remote camera, shutter speed might be set as a function of + -- focus perhaps, thus it is declared as a private operation (usable + -- only internally within the abstraction). + + + end F392D00; + + + --==================================================================-- + + + package body F392D00 is + + procedure Focus (C : in out Remote_Camera; + Depth : in Depth_Of_Field) is + begin + -- Artificial for testing purposes. + C.DOF := 46; + end Focus; + + ----------------------------------------------------------- + procedure Set_Shutter_Speed (C : in out Remote_Camera; + Speed : in Shutter_Speed) is + begin + -- Artificial for testing purposes. + C.Shutter := Thousand; + end Set_Shutter_Speed; + + ----------------------------------------------------------- + procedure Self_Test (C: in out Remote_Camera'Class) is + TC_Dummy_Depth : constant Depth_Of_Field := 23; + TC_Dummy_Speed : constant Shutter_Speed := Four_Hundred; + begin + + -- Test focus at various depths: + Focus(C, TC_Dummy_Depth); + -- ...Additional calls to Focus. + + -- Test various shutter speeds: + Set_Shutter_Speed(C, TC_Dummy_Speed); + -- ...Additional calls to Set_Shutter_Speed. + + end Self_Test; + + end F392D00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f393a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f393a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f393a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f393a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,245 ---- + -- F393A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation provides a simple background for a class family + -- based on an abstract type. It is to be used to test the + -- dispatching of various forms of subprogram defined/inherited and + -- overridden with the abstract type. + -- + -- type procedures functions + -- ---- ---------- --------- + -- Object Initialize, Swap(abstract) Create(abstract) + -- Object'Class Initialized + -- Windmill is new Object Swap, Stop, Add_Spin Create, Spin + -- Pump is new Windmill Set_Rate Create, Rate + -- Mill is new Windmill Swap, Stop Create + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package F393A00_0 is + procedure TC_Touch ( A_Tag : Character ); + procedure TC_Validate( Expected: String; Message: String ); + end F393A00_0; + + with Report; + package body F393A00_0 is + Expectation : String(1..20); + Finger : Natural := 0; + + procedure TC_Touch ( A_Tag : Character ) is + begin + Finger := Finger+1; + Expectation(Finger) := A_Tag; + end TC_Touch; + + procedure TC_Validate( Expected: String; Message: String ) is + begin + if Expectation(1..Finger) /= Expected then + Report.Failed( Message & " Expecting: " & Expected + & " Got: " & Expectation(1..Finger) ); + end if; + Finger := 0; + end TC_Validate; + end F393A00_0; + + ---------------------------------------------------------------------- + + package F393A00_1 is + type Object is abstract tagged private; + procedure Initialize( An_Object: in out Object ); + function Initialized( An_Object: Object'Class ) return Boolean; + procedure Swap( A,B: in out Object ) is abstract; + function Create return Object is abstract; + private + type Object is abstract tagged record + Initialized : Boolean := False; + end record; + end F393A00_1; + + with F393A00_0; + package body F393A00_1 is + procedure Initialize( An_Object: in out Object ) is + begin + An_Object.Initialized := True; + F393A00_0.TC_Touch('a'); + end Initialize; + + function Initialized( An_Object: Object'Class ) return Boolean is + begin + F393A00_0.TC_Touch('b'); + return An_Object.Initialized; + end Initialized; + end F393A00_1; + + ---------------------------------------------------------------------- + + with F393A00_1; + package F393A00_2 is + + type Rotational_Measurement is range -1_000 .. 1_000; + type Windmill is new F393A00_1.Object with private; + + procedure Swap( A,B: in out Windmill ); + + function Create return Windmill; + + procedure Add_Spin( To_Mill : in out Windmill; + RPMs : in Rotational_Measurement ); + + procedure Stop( Mill : in out Windmill ); + + function Spin( Mill : Windmill ) return Rotational_Measurement; + + private + type Windmill is new F393A00_1.Object with + record + Spin : Rotational_Measurement := 0; + end record; + end F393A00_2; + + with F393A00_0; + package body F393A00_2 is + + procedure Swap( A,B: in out Windmill ) is + T : constant Windmill := B; + begin + F393A00_0.TC_Touch('c'); + B := A; + A := T; + end Swap; + + function Create return Windmill is + A_Mill : Windmill; + begin + F393A00_0.TC_Touch('d'); + return A_Mill; + end Create; + + procedure Add_Spin( To_Mill : in out Windmill; + RPMs : in Rotational_Measurement ) is + begin + F393A00_0.TC_Touch('e'); + To_Mill.Spin := To_Mill.Spin + RPMs; + end Add_Spin; + + procedure Stop( Mill : in out Windmill ) is + begin + F393A00_0.TC_Touch('f'); + Mill.Spin := 0; + end Stop; + + function Spin( Mill : Windmill ) return Rotational_Measurement is + begin + F393A00_0.TC_Touch('g'); + return Mill.Spin; + end Spin; + + end F393A00_2; + + ---------------------------------------------------------------------- + + with F393A00_2; + package F393A00_3 is + type Pump is new F393A00_2.Windmill with private; + function Create return Pump; + + type Gallons_Per_Revolution is digits 3; + procedure Set_Rate( A_Pump: in out Pump; To_Rate: Gallons_Per_Revolution); + function Rate( Of_Pump: Pump ) return Gallons_Per_Revolution; + private + type Pump is new F393A00_2.Windmill with + record + GPRPM : Gallons_Per_Revolution := 0.0; -- Gallons/RPM + end record; + end F393A00_3; + + with F393A00_0; + package body F393A00_3 is + function Create return Pump is + Sump : Pump; + begin + F393A00_0.TC_Touch('h'); + return Sump; + end Create; + + procedure Set_Rate( A_Pump: in out Pump; To_Rate: Gallons_Per_Revolution) + is + begin + F393A00_0.TC_Touch('i'); + A_Pump.GPRPM := To_Rate; + end Set_Rate; + + function Rate( Of_Pump: Pump ) return Gallons_Per_Revolution is + begin + F393A00_0.TC_Touch('j'); + return Of_Pump.GPRPM; + end Rate; + end F393A00_3; + + ---------------------------------------------------------------------- + + with F393A00_2; + with F393A00_3; + package F393A00_4 is + type Mill is new F393A00_2.Windmill with private; + + procedure Swap( A,B: in out Mill ); + function Create return Mill; + procedure Stop( It: in out Mill ); + private + type Mill is new F393A00_2.Windmill with + record + Pump: F393A00_3.Pump := F393A00_3.Create; + end record; + end F393A00_4; + + with F393A00_0; + package body F393A00_4 is + procedure Swap( A,B: in out Mill ) is + T: constant Mill := A; + begin + F393A00_0.TC_Touch('k'); + A := B; + B := T; + end Swap; + + function Create return Mill is + A_Mill : Mill; + begin + F393A00_0.TC_Touch('l'); + return A_Mill; + end Create; + + procedure Stop( It: in out Mill ) is + begin + F393A00_0.TC_Touch('m'); + F393A00_3.Stop( It.Pump ); + F393A00_2.Stop( F393A00_2.Windmill( It ) ); + end Stop; + end F393A00_4; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f393b00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f393b00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f393b00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f393b00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,101 ---- + -- F393B00.A + -- Alert_Foundation + -- + -- 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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This package declares three abstract types for use in C660 series + -- tests, Alert, Special_Alert, and Private_Alert. + -- It models (in miniature) an application situation in which an + -- abstraction is defined in terms of structure (record and operations + -- on the record) but not in terms of content (record is null). It + -- also models a situation in which an abstraction includes some + -- specific, implementation dependent, information. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package F393B00 is + type Alert is abstract tagged null record; -- abstract type + -- see procedure Handle below + + procedure Handle (A : in out Alert) is abstract; + -- abstract procedure, + -- explicitly declared + + + type Private_Alert is abstract tagged private; + + procedure Handle (PA : in out Private_Alert) is abstract; + -- ensures that Private_Alert + -- is visibly abstract + + + type Status_Kind is (Practice, Real, Dont_Care); + type Urgency_Kind is (Low, Medium, High); + + type Practice_Alert is new Alert with record + Status : Status_Kind := Dont_Care; + Urgency : Urgency_Kind := Low; + end record; + + procedure Handle (PA : in out Practice_Alert); + -- overrides inherited Handle + + + + type Device is (Teletype, Console, Big_Screen); + + type Special_Alert (Age : Integer) is + abstract new Practice_Alert with record + Display : Device; + end record; + + procedure Handle (SA : in out Special_Alert) is abstract; + -- overrides inherited Handle + + private + subtype Implementation_Detail is Integer range 1..10; + + type Private_Alert is abstract tagged record + Private_Field : Implementation_Detail := 1; + end record; + + + end F393B00; + + --=======================================================================-- + + package body F393B00 is + + procedure Handle (PA : in out Practice_Alert) is + begin + PA.Status := Real; + PA.Urgency := Medium; + end Handle; + + end F393B00; + diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f3a2a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f3a2a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f3a2a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f3a2a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,81 ---- + -- F3A2A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares support types and subprograms for testing + -- run-time accessibility checks. + -- + -- CHANGE HISTORY: + -- 01 May 95 SAIC Initial prerelease version. + -- + --! + + package F3A2A00 is + + type Tagged_Type is tagged record + C: Integer := 0; + end record; + + type Array_Type is array (1 .. 10) of Tagged_Type; + + type AccTag_L0 is access all Tagged_Type; + type AccTagClass_L0 is access all Tagged_Type'Class; + + type AccArr_L0 is access all Array_Type; + + X_L0 : Tagged_Type; + + + type TC_Result_Kind is (OK, P_E, O_E); + + procedure TC_Display_Results (Actual : in TC_Result_Kind; + Expected: in TC_Result_Kind; + Message : in String); + end F3A2A00; + + + --==================================================================-- + + + with Report; + package body F3A2A00 is + + procedure TC_Display_Results (Actual : in TC_Result_Kind; + Expected: in TC_Result_Kind; + Message : in String) is + begin + if Actual /= Expected then + case Actual is + when OK => + Report.Failed ("No exception raised: " & Message); + when P_E => + Report.Failed ("Program_Error raised: " & Message); + when O_E => + Report.Failed ("Unexpected exception raised: " & Message); + end case; + end if; + end TC_Display_Results; + + end F3A2A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f460a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f460a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f460a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f460a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,90 ---- + -- F460A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares support types and subprograms for testing + -- run-time accessibility checks. + -- + -- CHANGE HISTORY: + -- 11 May 95 SAIC Initial prerelease version. + -- 24 Apr 96 SAIC Modified Array_Type. + -- + --! + + package F460A00 is + + type Tagged_Type is tagged record + C : Integer := 0; + end record; + + type Derived_Tagged_Type is new Tagged_Type with record + D : String (1 .. 4) := "void"; + end record; + + type Composite_Type (D: access Tagged_Type) is limited record + C : Boolean; + end record; + + type Array_Type is array (1 .. 10) of Tagged_Type; + + type AccTag_L0 is access constant Tagged_Type; + type AccTagClass_L0 is access all Tagged_Type'Class; + + type AccArr_L0 is access all Array_Type; + + X_DerivedTag : aliased Derived_Tagged_Type; + PTagClass_L0 : AccTagClass_L0 := X_DerivedTag'Access; + + type TC_Result_Kind is (OK, UN_Init, PE_Exception, Others_Exception); + + procedure TC_Check_Results (Actual : in TC_Result_Kind; + Expected: in TC_Result_Kind; + Message : in String); + end F460A00; + + + --==================================================================-- + + + with Report; + package body F460A00 is + + procedure TC_Check_Results (Actual : in TC_Result_Kind; + Expected: in TC_Result_Kind; + Message : in String) is + begin + if Actual /= Expected then + case Actual is + when OK | UN_Init => + Report.Failed ("No exception raised: " & Message); + when PE_Exception => + Report.Failed ("Program_Error raised: " & Message); + when Others_Exception => + Report.Failed ("Unexpected exception raised: " & Message); + end case; + end if; + end TC_Check_Results; + + end F460A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f730a000.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f730a000.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f730a000.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f730a000.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,107 ---- + -- F730A000.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This file simulates a generic linked list abstraction for use in tests + -- covering tagged types and type extensions. + -- + -- TEST FILES: + -- This foundation consists of the following files: + -- + -- => F730A000.A + -- F730A001.A + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- 03 Aug 96 SAIC ACVC 2.1: Modified prologue. Added pragma + -- Elaborate_Body. Removed extraneous record + -- extension. + -- + --! + + generic -- Singly-linked list abstraction. + type Parent_Type is tagged private; -- Actual is parent + package F730A000 is -- tagged type. + + pragma Elaborate_Body; + + + -- Declarations for private linked list nodes: + + type Priv_Node_Type is new Parent_Type with private; -- Private extension + -- of parent type. + + -- Inherits primitive operations of actual parameter corresponding + -- to Parent_Type. + + + type Priv_Node_Ptr is access Priv_Node_Type; + + + -- Add node at head of list. + procedure Add (Item : in Priv_Node_Ptr; + Head : in out Priv_Node_Ptr); + + -- Remove node from head of list and return it. + procedure Remove (Head : in out Priv_Node_Ptr; + Item : out Priv_Node_Ptr); + + + private + + type Priv_Node_Type is new Parent_Type with record + Next : Priv_Node_Ptr := null; + end record; + + end F730A000; + + + --==================================================================-- + + + package body F730A000 is -- Singly-linked list abstraction. + + + procedure Add (Item : in Priv_Node_Ptr; + Head : in out Priv_Node_Ptr) is + begin + if Item /= null then + Item.Next := Head; + Head := Item; + end if; + end Add; + + + procedure Remove (Head : in out Priv_Node_Ptr; + Item : out Priv_Node_Ptr) is + begin + Item := Head; + if Head /= null then + Head := Head.Next; + end if; + end Remove; + + + end F730A000; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f730a001.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f730a001.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f730a001.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f730a001.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,76 ---- + -- F730A001.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This file declares a tagged type and primitive subprogram for use in + -- tests covering tagged types and type extensions. + -- + -- TEST FILES: + -- The following files comprise this foundation: + -- + -- F730A000.A + -- => F730A001.A + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + + package F730A001 is -- Book definitions. + + + type Text_Ptr is access String; + + type Book_Type is tagged record -- Root tagged type. + Title : Text_Ptr; + Author : Text_Ptr; + end record; + + + procedure Create_Book (Title : in Text_Ptr; -- Primitive operation + Author : in Text_Ptr; -- of root tagged type. + Book : out Book_Type); + + + end F730A001; + + + --==================================================================-- + + + package body F730A001 is -- Book definitions. + + + procedure Create_Book (Title : in Text_Ptr; + Author : in Text_Ptr; + Book : out Book_Type) is + begin + Book.Title := Title; + Book.Author := Author; + end Create_Book; + + + end F730A001; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f731a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f731a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f731a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f731a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,66 ---- + -- F731A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares parent tagged types and subprograms for use + -- in tests covering operations of private types and private extensions. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package F731A00 is + + type Parent is tagged private; + + function Vis_Op (P: Parent) return Boolean; + + private + + type Parent is tagged record + Component : Integer := 1; + end record; + + function Pri_Op (P: Parent) return Boolean; + + end F731A00; + + + --==================================================================-- + + + package body F731A00 is + function Vis_Op (P: Parent) return Boolean is + begin + return True; + end Vis_Op; + + function Pri_Op (P: Parent) return Boolean is + begin + return False; + end Pri_Op; + + end F731A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f940a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f940a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f940a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f940a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,97 ---- + -- F940A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation contains test control code for tests covering + -- the protected record. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package F940A00 is + -- Interlock_Foundation + + protected type Interlock_Type is + entry Post; + entry Consume; + private + Int_Count : Integer := 0; + end Interlock_Type; + + protected Counter is -- used to count the number of + procedure Increment; -- resources that have been granted + procedure Decrement; -- to tasks + function Number return integer; + private + Count : Integer := 0; + end Counter; + + end F940A00; + -- Interlock_Foundation + + --===================================-- + + package body F940A00 is + -- Interlock_Foundation + + protected body Interlock_Type is + + entry Post when true is + begin + Int_Count := Int_Count + 1; + end Post; + + entry Consume when Int_Count > 0 is + begin + Int_Count := Int_Count - 1; + end Consume; + + end Interlock_Type; + + + protected body Counter is + + procedure Increment is + begin + Count := Count + 1; + end Increment; + + procedure Decrement is + begin + Count := Count - 1; + end Decrement; + + function Number return Integer is + begin + return Count; + end Number; + + end Counter; + + end F940A00; + -- Interlock_Foundation diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/f954a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/f954a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/f954a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/f954a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,134 ---- + -- F954A00.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: + -- This file contains foundation code for tests covering the requeue + -- statement. + -- + -- TEST DESCRIPTION: + -- See prologues of specific tests. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package F954A00 is -- Printer device abstraction. + + + -- Model a printer device driver as a protected type. A printer remains + -- unavailable while data is printing. The printer generates an interrupt + -- when printing is complete, after which the printer is again made + -- available. + + + type Printers_Info is tagged record + Some_Info : Integer; + end record; + + --==============================================-- + + protected type Printers is -- Device driver for printer. + + procedure Start_Printing (File_Name : String); -- Begin printing on + -- printer. + + procedure Handle_Interrupt; -- Handle interrupt from + -- printer. + + entry Done_Printing; -- Wait until printer is + -- done. + + function Available return Boolean; -- Return value of Ready. + function Is_Done return Boolean; -- Return value of Done. + + private + + Ready : Boolean := True; -- Entry barrier. + Done : Boolean := True; -- Testing flag. + + end Printers; + + --==============================================-- + + Number_Of_Printers : constant := 2; + + type Printer_ID is range 1 .. Number_Of_Printers; + + type Printer_Array is array (Printer_ID) of Printers; + type Info_Array is array (Printer_ID) of Printers_Info; + + Printer : Printer_Array; + Printer_Info : constant Info_Array := ( (Some_Info => 1), + (Some_Info => 2) ); + + end F954A00; + + + --==================================================================-- + + + package body F954A00 is -- Printer server abstraction. + + + protected body Printers is + + procedure Start_Printing (File_Name : String) is + begin + Ready := False; -- Block other requests + Done := False; -- for this printer + -- Send data to the printer... -- and begin printing. + end Start_Printing; + + + -- Set the "not ready" one-shot + entry Done_Printing when Ready is -- Callers wait here + begin -- until printing is + Done := True; -- done (signaled by a + end Done_Printing; -- printer interrupt). + + + procedure Handle_Interrupt is -- Called when the + begin -- printer interrupts, + Ready := True; -- indicating that + end Handle_Interrupt; -- printing is done. + + + function Available return Boolean is -- Artifice for test + begin -- purposes: checks + return (Ready); -- whether printer is + end Available; -- still printing. + + + function Is_Done return Boolean is -- Artifice for test + begin -- purposes: checks + return (Done); -- whether Done_Printing + end Is_Done; -- entry was executed. + + end Printers; + + + end F954A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fa11a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fa11a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fa11a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fa11a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,73 ---- + -- FA11A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares a tagged type and primitive subprograms in + -- a parent package. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package FA11A00 is -- Widget_Pkg + -- This package represents processing of widgets in a window system. It + -- contains a tagged type that can be extended by its children. + + type Widget_Length is range 1 .. 100; + + type Widget is tagged -- Parent tagged type + record + Width, Height : Widget_Length; + -- More components to be added by extension + end record; + + -- To be inherited by its children derivatives. + procedure Set_Width (The_Widget : in out Widget; + W : in Widget_Length); + + -- To be inherited by its children derivatives. + procedure Set_Height (The_Widget : in out Widget; + H : in Widget_Length); + + end FA11A00; -- Widget_Pkg + + --=======================================================================-- + + package body FA11A00 is -- Widget_Pkg + + procedure Set_Width (The_Widget : in out Widget; + W : in Widget_Length) is + begin + The_Widget.Width := W; + end Set_Width; + ------------------------------------------------------- + procedure Set_Height (The_Widget : in out Widget; + H : in Widget_Length) is + begin + The_Widget.Height := H; + end Set_Height; + + end FA11A00; -- Widget_Pkg diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fa11b00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fa11b00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fa11b00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fa11b00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,110 ---- + -- FA11B00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares parent types and operations that can + -- be inherited by its children. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package FA11B00 is -- Application_One_Widget + -- This foundation simulates code that might be obtained as an already + -- implemented set of objects and services, perhaps from a source code + -- vendor. It represents processing of widgets in a window system. + -- These widgets all have the same characteristics, but they are application + -- specific, so we do not allow assignment of an App_1_Widget to App_2_Widget. + + -- The dimension measurement is in pixels (dots on the screen). + type Pixels is range 0 .. 10_000; + type Widget_Id is new Integer; + type Widget_Color_Enum is (Amber, Green, White, None); + subtype Widget_Label_Str is string (1 .. 15); + + type Widget_Location is + record + X_Location, Y_Location : Pixels; + end record; + + type Widget_Size is + record + X_Length, Y_Length : Pixels; + end record; + + -- NOTE : not a tagged record. + type App1_Widget (Maximum_Size : Pixels := Pixels'Last) + is record -- Parent type + Size : Widget_Size := (Maximum_Size, Maximum_Size); + ID : Widget_Id := 1; + Location : Widget_Location := (0,0); + Color : Widget_Color_Enum := None; + Label : Widget_Label_Str := " "; + end record; + + -- Primitive operation of type Widget. + -- To be inherited by its children derivatives. + procedure App1_Widget_Specific_Oper (The_Widget : in out App1_Widget; + I : in Widget_Id; + C : in Widget_Color_Enum; + L : in Widget_Label_Str); + + end FA11B00; -- Application_One_Widget + + --=======================================================================-- + + package body FA11B00 is -- Application_One_Widget + + procedure Set_Color (The_Widget : in out App1_Widget; + C : in Widget_Color_Enum) is + begin + The_Widget.Color := C; + end Set_Color; + ------------------------------------------------------------- + procedure Set_Label (The_Widget : in out App1_Widget; + L : in Widget_Label_Str) is + begin + The_Widget.Label := L; + end Set_Label; + ------------------------------------------------------------- + procedure Set_Id (The_Widget : in out App1_Widget; + I : in Widget_Id) is + begin + The_Widget.Id := I; + end Set_Id; + ------------------------------------------------------------- + procedure App1_Widget_Specific_Oper + (The_Widget : in out App1_Widget; + I : in Widget_Id; + C : in Widget_Color_Enum; + L : in Widget_Label_Str) is + begin + Set_Color (The_Widget, C); + Set_Label (The_Widget, L); + Set_Id (The_Widget, I); + end App1_Widget_Specific_Oper; + + end FA11B00; -- Application_One_Widget diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fa11c00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fa11c00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fa11c00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fa11c00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,112 ---- + -- FA11C00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares parent types and operations that can + -- be inherited by its children. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package FA11C00_0 is -- Package Animal + + type Kilogram_Weight_Type is new Natural; + subtype Species_Name_Type is String (1 .. 20); + + type Animal is tagged + record + Common_Name : Species_Name_Type; + Weight : Kilogram_Weight_Type; + end record; + + function Image (A : Animal) return String; + + end FA11C00_0; -- Package Animal + + --=================================================================-- + + package body FA11C00_0 is -- Package body Animal + + function Image (A : Animal) return String is + begin + return ("Animal Species: " & A.Common_Name); + end Image; + + end FA11C00_0; -- Package body Animal + + --=================================================================-- + + package FA11C00_0.FA11C00_1 is -- Package Animal.Mammal + + type Hair_Color_Type is (Black, Brown, Blonde, Grey, White, Red); + + type Mammal is new Animal with + record + Hair_Color : Hair_Color_Type; + end record; + + function Image (M : Mammal) return String; + + end FA11C00_0.FA11C00_1; -- Package Animal.Mammal + + --=================================================================-- + + package body FA11C00_0.FA11C00_1 is -- Package body Animal.Mammal + + function Image (M : Mammal) return String is + begin + return ("Mammal Species: " & M.Common_Name); + end Image; + + end FA11C00_0.FA11C00_1; -- Package body Animal.Mammal + + --=================================================================-- + + package FA11C00_0.FA11C00_1.FA11C00_2 is -- Package Animal.Mammal.Primate + + type Habitat_Type is (Arboreal, Terrestrial); + + type Primate is new Mammal with + record + Habitat : Habitat_Type; + end record; + + function Image (P : Primate) return String; + + end FA11C00_0.FA11C00_1.FA11C00_2; -- Package Animal.Mammal.Primate + + --=================================================================-- + + -- Package body Animal.Mammal.Primate + package body FA11C00_0.FA11C00_1.FA11C00_2 is + + function Image (P : Primate) return String is + begin + return ("Primate Species: " & P.Common_Name); + end Image; + + end FA11C00_0.FA11C00_1.FA11C00_2; -- Package body Animal.Mammal.Primate diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fa11d00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fa11d00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fa11d00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fa11d00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,78 ---- + -- FA11D00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares parent types and operations that can + -- be inherited by its children. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- 21 Dec 94 SAIC Modified type Int_Type + -- + --! + + package FA11D00 is -- Complex_Definition_Pkg + + -- Simulate a complex number support package. Complex numbers + -- are treated as coordinates in the Cartesian plane. + + type Int_Type is range -200 .. 100; + + type Complex_Type is record + Real : Int_Type; + Imag : Int_Type; + end record; + + Zero : constant Complex_Type := (Real => 0, Imag => 0); + One : constant Complex_Type := (Real => 1, Imag => 0); + Check_Value : constant Complex_Type := (Real => 17, Imag => 23); + + Add_Error : exception; + Subtract_Error : exception; + Divide_Error : exception; + Multiply_Error : exception; + + TC_Handled_In_Caller, + TC_Handled_In_Child_Pkg_Proc, + TC_Handled_In_Child_Pkg_Func, + TC_Handled_In_Grandchild_Pkg_Proc, + TC_Handled_In_Grandchild_Pkg_Func, + TC_Handled_In_Child_Sub, + TC_Propagated_To_Caller : boolean := False; + + function Complex (Real, Imag : Int_Type) + return Complex_Type; + + end FA11D00; -- Complex_Definition_Pkg + + --=======================================================================-- + + package body FA11D00 is -- Complex_Definition_Pkg + function Complex (Real, Imag : Int_Type) return Complex_Type is + begin + return (Real, Imag); + end Complex; + + end FA11D00; -- Complex_Definition_Pkg diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fa13a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fa13a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fa13a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fa13a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,171 ---- + -- FA13A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation code is used to check visibility of separate + -- subunit of child packages. + -- Declares a package containing type definitions; package will be + -- with'ed by the root of the elevator abstraction. + -- + -- Declare an elevator abstraction in a parent root package which manages + -- basic operations. This package has a private part. Declare a + -- private child package which calculates the floors for going up or + -- down. Declare a public child package which provides the actual + -- operations. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + -- Simulates a fragment of an elevator operation application. + + package FA13A00_0 is -- Building Manager + + type Electrical_Power is (Off, V120, V240); + Power : Electrical_Power := V120; + + -- other type definitions and procedure declarations in real application. + + end FA13A00_0; + + -- No bodies provided for FA13A00_0. + + --==================================================================-- + + package FA13A00_1 is -- Basic Elevator Operations + + type Call_Waiting_Type is private; + type Floor is (Basement, Floor1, Floor2, Floor3, Penthouse); + type Floor_No is range Floor'Pos(Floor'First) .. Floor'Pos(Floor'Last); + Current_Floor : Floor := Floor1; + + TC_Operation : boolean := true; + + procedure Call (F : in Floor; C : in out Call_Waiting_Type); + procedure Clear_Calls (C : in out Call_Waiting_Type); + + private + type Call_Waiting_Type is array (Floor) of boolean; + Call_Waiting : Call_Waiting_Type := (others => false); + + end FA13A00_1; + + + --==================================================================-- + + package body FA13A00_1 is + + -- Call the elevator. + + procedure Call (F : in Floor; C : in out Call_Waiting_Type) is + begin + C (F) := true; + end Call; + + -------------------------------------------- + + -- Clear all calls of the elevator. + + procedure Clear_Calls (C : in out Call_Waiting_Type) is + begin + C := (others => false); + end Clear_Calls; + + end FA13A00_1; + + --==================================================================-- + + -- Private child package of an elevator application. This package calculates + -- how many floors to go up or down. + + private package FA13A00_1.FA13A00_2 is -- Floor Calculation + + -- Other type definitions in real application. + + procedure Up (HowMany : in Floor_No); + + procedure Down (HowMany : in Floor_No); + + end FA13A00_1.FA13A00_2; + + --==================================================================-- + + package body FA13A00_1.FA13A00_2 is + + -- Go up from the current floor. + + procedure Up (HowMany : in Floor_No) is + begin + Current_Floor := Floor'val (Floor'pos (Current_Floor) + HowMany); + end Up; + + -------------------------------------------- + + -- Go down from the current floor. + + procedure Down (HowMany : in Floor_No) is + begin + Current_Floor := Floor'val (Floor'pos (Current_Floor) - HowMany); + end Down; + + end FA13A00_1.FA13A00_2; + + --==================================================================-- + + -- Public child package of an elevator application. This package provides + -- the actual operation of the elevator. + + package FA13A00_1.FA13A00_3 is -- Move Elevator + + -- Other type definitions in real application. + + procedure Move_Elevator (F : in Floor; + C : in out Call_Waiting_Type); + + end FA13A00_1.FA13A00_3; + + --==================================================================-- + + with FA13A00_1.FA13A00_2; -- Floor Calculation + + package body FA13A00_1.FA13A00_3 is + + -- Going up or down depends on the current floor. + + procedure Move_Elevator (F : in Floor; + C : in out Call_Waiting_Type) is + begin + if F > Current_Floor then + FA13A00_1.FA13A00_2.Up (Floor'Pos (F) - Floor'Pos (Current_Floor)); + FA13A00_1.Call (F, C); + elsif F < Current_Floor then + FA13A00_1.FA13A00_2.Down (Floor'Pos (Current_Floor) - Floor'Pos (F)); + FA13A00_1.Call (F, C); + end if; + + end Move_Elevator; + + end FA13A00_1.FA13A00_3; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fa13b00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fa13b00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fa13b00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fa13b00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,106 ---- + -- FA13B00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation code is used to check visibility of separate + -- subunit of child packages. + -- Declares a package containing type definitions and a private + -- part; package will be with'ed by the parent's body of the subunits. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package FA13B00_0 is + + -- Type definitions. + + type Visible_Integer is range 1 .. 10; + + type Private_Record is private; + + type Visible_Tagged is tagged + record + PR : Private_Record; + end record; + + type Private_Tagged is tagged private; + + Visible_Num : Visible_Integer := 7; + + -- Subprogram definitions. + + function Assign_Visible_Tagged (I : Visible_Integer) + return Visible_Tagged; + + function Assign_Private_Tagged (I : Visible_Integer) + return Private_Tagged; + + private + + -- Type definitions. + + type Private_Integer is range 11 .. 20; + + type Private_Record is + record + VI : Visible_Integer; + end record; + + type Private_Tagged is tagged + record + VI : Visible_Integer; + end record; + + -- Object definitions. + + Private_Num : Visible_Integer := 6; + + end FA13B00_0; + + --==================================================================-- + + package body FA13B00_0 is + + function Assign_Visible_Tagged(I : Visible_Integer) + return Visible_Tagged is + VT : Visible_Tagged := (PR => (VI => I)); + begin + return VT; + end Assign_Visible_Tagged; + + ------------------------------------------------------- + + function Assign_Private_Tagged (I : Visible_Integer) + return Private_Tagged is + PT : Private_Tagged := (VI => I); + begin + return PT; + end Assign_Private_Tagged; + + ------------------------------------------------------- + + end FA13B00_0; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fa21a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fa21a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fa21a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fa21a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,127 ---- + -- FA21A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares various supporting types, objects, and + -- subprograms for use in tests checking preelaborability. + -- + -- CHANGE HISTORY: + -- 20 Mar 95 SAIC Initial prerelease version. + -- + --! + + with Ada.Finalization; -- Preelaborated library unit. + package FA21A00 is + + pragma Preelaborate (FA21A00); + + + type My_Int is new Integer range 0 .. 100; + function Func return My_Int; -- Non-static function. + + subtype Idx is Natural range 1 .. 5; + + Three : constant My_Int := 3; + Ten : My_Int := 10; -- Non-static. + + type RecWithDisc (D: My_Int) is record + Twice: My_Int := D*2; + end record; + + type RecCallDefault is record + C : My_Int := Func; + D : My_Int := 0; + end record; + + type RecPrimDefault is record + C : My_Int := Ten; + end record; + + type Tag is tagged record + C : My_Int; + end record; + + type AccTag is access all Tag; + + Tag1: aliased Tag; -- OK. + + type My_Controlled is new Ada.Finalization.Controlled with record + C : My_Int; + end record; + + type ContComp is tagged record + C: My_Controlled; + end record; + + task type Tsk (D: My_Int); + + protected type Prot is + entry E; + end Prot; + + type Priv is tagged private; + + type PrivComp is array (1 .. 5) of Priv; + + type Pri_Ext is new Tag with private; + + type PriExtComp is array (1 .. 5) of Pri_Ext; + + private + + type Priv is tagged record + B: Boolean; + end record; + + type Pri_Ext is new Tag with record + N: String (1 .. 5); + end record; + + end FA21A00; + + + --===================================================================-- + + + package body FA21A00 is + + task body Tsk is + begin + null; + end Tsk; + + protected body Prot is + entry E when False is + begin + null; + end E; + end Prot; + + function Func return My_Int is + begin + return 0; + end Func; + + end FA21A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fb20a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fb20a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fb20a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fb20a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,101 ---- + -- FB20A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This test performs a search for the first instance of a specified + -- substring within a specified string, returning boolean result. + -- (Case insensitive analysis) Both the string and the substring are + -- made upper case. Successive slices are taken from the input string + -- and compared with the substring. If a match is found, the search is + -- terminated immediately. The search continues until the last index + -- position from which a substring-length slice can be constructed is + -- passed. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package FB20A00 is + + function Find ( Str : in String ; + Sub : in String ) return Boolean; + + end FB20A00; + + --=================================================================-- + + package body FB20A00 is + + function Find ( Str : in String ; + Sub : in String ) return Boolean is + + New_Str : String (Str'First .. Str'Last); + New_Sub : String (Sub'First .. Sub'Last); + + Pos : Integer := Str'First ; -- Character index. + + + function Upper_Case (Str : in String) return String is + subtype Upper is Character range 'A' .. 'Z' ; + subtype Lower is Character range 'a' .. 'z' ; + Ret : String (Str'First .. Str'Last) ; + Pos : Integer; + begin + for I in Str'Range loop + if ( Str (I) in Lower ) then + Pos := Upper'Pos (Upper'First) + + ( Lower'Pos (Str(I)) - Lower'Pos(Lower'First) ) ; + Ret (I) := Upper'Val (Pos) ; + else + Ret (I) := Str (I); + end if ; + end loop ; + return (Ret) ; + end Upper_Case; + + begin + + + New_Str := Upper_Case (Str); -- Convert Str and Sub to upper + New_Sub := Upper_Case (Sub); -- case for comparison. + + while ( Pos <= New_Str'Last-New_Sub'Length+1 ) -- Search until no more + and then -- sub-string-length + ( New_Str ( Pos .. Pos+New_Sub'Length-1 ) /= New_Sub ) -- slices + -- remain. + loop + Pos := Pos + 1 ; + end loop ; + + if ( Pos > New_Str'Last-New_Sub'Length+1 ) then -- Substring not found. + return (False); + else + return (True); + end if ; + + end Find; + + end FB20A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fb40a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fb40a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fb40a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fb40a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,81 ---- + -- FB40A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation package contains global variables, types, a user + -- defined exception, and two subprograms used to increment the + -- global variables. + -- See prologues of specific tests for specific information. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + + package FB40A00 is -- package Text_Parser + + -- Global Variables + + AlphaNumeric_Count, + Non_AlphaNumeric_Count : Natural := 0; + + + -- Types + + type String_Pointer_Type is access String; + + + -- Exceptions + + Completed_Text_Processing : exception; + + -- Subprograms + + procedure Increment_AlphaNumeric_Count; + procedure Increment_Non_AlphaNumeric_Count; + + end FB40A00; + + + --=================================================================-- + + + package body FB40A00 is + + + procedure Increment_AlphaNumeric_Count is + begin + AlphaNumeric_Count := AlphaNumeric_Count + 1; + end Increment_AlphaNumeric_Count; + + + procedure Increment_Non_AlphaNumeric_Count is + begin + Non_AlphaNumeric_Count := Non_AlphaNumeric_Count + 1; + end Increment_Non_AlphaNumeric_Count; + + + end FB40A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fc50a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fc50a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fc50a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fc50a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,92 ---- + -- FC50A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares various tagged types which will be passed as + -- actuals to generic formal tagged private types. It also declares + -- various objects of these types, which will be used for testing. + -- The types defined are both discriminated and nondiscriminated. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package FC50A00 is + + -- + -- Nonlimited tagged types: + -- + + type Count_Type is tagged record -- Nondiscriminated + Count : Integer := 0; -- type. + end record; + + + subtype Str_Len is Natural range 0 .. 100; + subtype Stu_ID is String (1 .. 5); + subtype Dept_ID is String (1 .. 4); + subtype Emp_ID is String (1 .. 9); + type Status is (Student, Faculty, Staff); + subtype Reserved is Positive range 1 .. 50; + + + type Person_Type (Stat : Status; -- Discriminated + NameLen, AddrLen : Str_Len) is -- type. + tagged record + Name : String (1 .. NameLen); + Address : String (1 .. AddrLen); + case Stat is + when Student => + Student_ID : Stu_ID; + when Faculty => + Department : Dept_ID; + when Staff => + Employee_ID : Emp_ID; + end case; + end record; + + + type VIPerson_Type is new Person_Type with record -- Extension of + Parking_Space : Reserved; -- discriminated type. + end record; + + + -- Testing entities: ------------------------------------------------ + + TC_Count_Item : constant Count_Type := (Count => 111); + TC_Default_Count : constant Count_Type := (Count => 0); + + TC_Person_Item : constant Person_Type := + (Faculty, 18, 17, "Eccles, John Scott", "Popham House, Lee", "0931"); + TC_Default_Person : constant Person_Type := + (Student, 0, 0, "", "", "00000"); + + TC_VIPerson_Item : constant VIPerson_Type := (TC_Person_Item with 1); + + --------------------------------------------------------------------- + + + end FC50A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fc51a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fc51a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fc51a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fc51a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,99 ---- + -- FC51A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation defines a fraction type abstraction. Fractions are + -- implemented as records with two scalar components: a numerator + -- of type integer and a denominator of type positive. Fractions are + -- created via an overloaded "/" operator. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package FC51A00 is -- Fraction type abstraction. + + type Fraction_Type is private; + + -- Create a fraction object by integer division. + function "/" (Left, Right : Integer) return Fraction_Type; + + -- Change the sign of a fraction. + function "-" (Frac : Fraction_Type) return Fraction_Type; + + -- Return value of numerator as integer. + function Numerator (Frac : Fraction_Type) return Integer; + + -- Return value of denominator as integer. + function Denominator (Frac : Fraction_Type) return Integer; + + -- ... Other operations on fraction types. + + private + + type Fraction_Type is record + Numerator : Integer; + Denominator : Positive; + end record; + + end FC51A00; + + + --==================================================================-- + + + package body FC51A00 is + + function "/" (Left, Right : Integer) return Fraction_Type is + Result : Fraction_Type; + begin + Result.Numerator := Left; + Result.Denominator := Right; + return Result; + end "/"; + + + function "-" (Frac : Fraction_Type) return Fraction_Type is + Result : Fraction_Type := Frac; + begin + Result.Numerator := -(Result.Numerator); + return Result; + end "-"; + + + function Numerator (Frac : Fraction_Type) return Integer is + begin + return (Frac.Numerator); + end Numerator; + + + function Denominator (Frac : Fraction_Type) return Integer is + begin + return (Frac.Denominator); + end Denominator; + + + end FC51A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fc51b00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fc51b00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fc51b00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fc51b00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,62 ---- + -- FC51B00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares a set of tagged and untagged indefinite + -- subtypes. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package FC51B00 is -- Type definitions. + + subtype Size is Natural range 1 .. 4; + + type Matrix is array -- Unconstrained array + (Size range <>, Size range <>) of Integer; -- type. + + type Square (Side : Size) is record -- Unconstrained record + Mat : Matrix (1 .. Side, 1 .. Side); -- with undefaulted + end record; -- discriminants. + + type Square_Pair (Dimension : Size) is tagged record -- Unconstrained tagged + Left : Square (Dimension); -- type. + Right : Square (Dimension); + end record; + + type Vector is tagged record -- Constrained tagged + Mat : Matrix (1 .. 3, 1 .. 1); -- type (used to get + end record; -- class-wide type). + + generic -- Template for a generic formal package. + type Vectors (<>) is new Vector with private; -- Type with unknown + package Signature is end; -- discriminants. + + end FC51B00; + + + -- No body for FC51B00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fc51c00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fc51c00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fc51c00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fc51c00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,112 ---- + -- FC51C00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares a hierarchy of tagged types, which includes + -- both abstract and non-abstract types, and which have both abstract + -- and non-abstract primitive subprograms. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- 03 Nov 95 SAIC ACVC 2.0.1 fixes: Deleted primitive operation Proc + -- of Concrete_Root. + -- 11 Aug 96 SAIC ACVC 2.1: Changed procedure bodies to update + -- actual parameters. + -- + --! + + package FC51C00 is + + -- + -- Non-abstract ultimate ancestor type: + -- + + type Concrete_Root is tagged null record; + + function Func (P: Concrete_Root) return Concrete_Root; -- Abstract when + -- inherited. + + + -- + -- Abstract descendant of non-abstract ultimate ancestor: + -- + + type Abstract_Child is abstract new Concrete_Root with null record; + + -- Inherits: + -- function Func (P: Abstract_Child) return Abstract_Child is abstract; + + procedure Proc (P: in out Abstract_Child) is abstract; -- Abstract. + procedure New_Proc (P : out Abstract_Child) is abstract; -- Abstract. + + + + -- + -- Non-abstract descendant of abstract descendant: + -- + + type Concrete_GrandChild is new Abstract_Child with null record; + + function Func (P: Concrete_GrandChild) return Concrete_GrandChild; + + procedure Proc (P: in out Concrete_GrandChild); + procedure New_Proc (P : out Concrete_GrandChild); + + + end FC51C00; + + + --===================================================================-- + + + package body FC51C00 is + + Value : Concrete_GrandChild; + + + function Func (P: Concrete_Root) return Concrete_Root is + begin + return P; + end Func; + + + function Func (P: Concrete_GrandChild) return Concrete_GrandChild is + begin + return P; + end Func; + + + procedure Proc (P: in out Concrete_GrandChild) is + begin + P := Value; + end Proc; + + + procedure New_Proc (P : out Concrete_GrandChild) is + begin + P := Value; + end New_Proc; + + end FC51C00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fc51d00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fc51d00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fc51d00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fc51d00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,82 ---- + -- FC51D00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation defines a generic list abstraction. List elements can + -- be of any (nonlimited) type. Lists are implemented as arrays of + -- pointers and are only two elements in length. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + generic + type Element_Type (<>) is private; + package FC51D00 is -- This package simulates a generic list abstraction. + + -- The definition of List_Type below is purely artificial; its validity + -- in the context of the abstraction is irrelevant to the feature being + -- tested. + + type Element_Ptr is access Element_Type; + + subtype List_Size is Natural range 1 .. 2; + type List_Type is array (List_Size) of Element_Ptr; + + function View_Element (I : List_Size; L : List_Type) return Element_Type; + + procedure Write_Element (I : in List_Size; + L : in out List_Type; + E : in Element_Type); + + -- ... Other list operations for Element_Type. + + end FC51D00; + + + --==================================================================-- + + + package body FC51D00 is + + -- The implementations of the operations below are purely artificial; the + -- validity of their implementations in the context of the abstraction is + -- irrelevant to the feature being tested. + + function View_Element (I : List_Size; L : List_Type) return Element_Type is + begin + return L(I).all; + end View_Element; + + + procedure Write_Element (I : in List_Size; + L : in out List_Type; + E : in Element_Type) is + begin + L(I) := new Element_Type'(E); + end Write_Element; + + end FC51D00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fc54a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fc54a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fc54a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fc54a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,132 ---- + -- FC54A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares various types which will serve as designated + -- types for tests involving generic formal access types (including + -- access-to-subprogram types). + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package FC54A00 is + + + -- Discrete (integer) types: + + Bits : constant := 8; -- Named number. + + type Numerals is range -256 .. 255; + type New_Numerals is new Numerals range -128 .. 127; + subtype Positives is Numerals range 0 .. 255; + subtype Same_Numerals is Numerals; + subtype Numerals_Static is Numerals range -2**Bits .. 2**Bits - 1; + + Min : Numerals := Numerals'First; -- Variable. + Max : Integer := 255; -- Variable. + + subtype Numerals_Nonstatic is Numerals range Min .. 255; + subtype Positive_Nonstatic is Positives range 0 .. Positives(Max); + subtype Pos_Dupl_Nonstatic is Positives range 0 .. Positives(Max); + subtype Pos_Attr_Nonstatic is Positives range Positive_Nonstatic'Range; + + + + -- Floating point types: + + type Float_Type is digits 3; + type New_Float is new Float_Type; + subtype Float_100 is Float_Type range 0.0 .. 100.0; + subtype Same_Float is Float_Type; + + Hundred : constant := 100.0; -- Named number. + + type Float_With_Range is digits 3 range 0.0 .. 100.0; + subtype Float_Same_Range is Float_With_Range range 0.0 .. Hundred; + + + + -- Tagged record types: + + subtype Lengths is Natural range 0 .. 50; + + type Parent is abstract tagged null record; + + type Tag (Len: Lengths) is new Parent with record + Msg : String (1 .. Len); + end record; + + type New_Tag is new Tag with record + Sent : Boolean; + end record; + + subtype Same_Tag is Tag; + + Twenty : constant := 20; -- Named number. + + subtype Tag20 is Tag (Len => 20); + subtype Tag25 is Tag (25); + subtype Tag_Twenty is Tag (Twenty); + + My_Len : Lengths := Twenty; -- Variable. + subtype Sub_Length is Lengths range 1 .. My_Len; + + subtype Tag20_Nonstatic is Tag (Len => Sub_Length'Last); + subtype Tag20_Dupl_Nonstatic is Tag (Sub_Length'Last); + subtype Tag20_Same_Nonstatic is Tag20_Nonstatic; + subtype Tag20_Var_Nonstatic is Tag (Len => My_Len); + + + + -- Access types (designated type is tagged): + + type Tagged_Ptr is access Tag; + type Tag_Class_Ptr is access Tag'Class; + + subtype Msg_Ptr_Static is Tagged_Ptr(Twenty); + + + + -- Array types: + + type New_String is new String; + subtype Same_String is String; + + Ten : constant := 10; -- Named number. + + subtype Msg_Static is String(1 .. Ten); + type Msg10 is new String(1 .. 10); + subtype Msg20 is String(1 .. 20); + + Size : Positive := 10; + + subtype Msg_Nonstatic is String(1 .. Size); + subtype Msg_Dupl_Nonstatic is String(1 .. Size); + subtype Msg_Same_Nonstatic is Msg_Nonstatic; + + + end FC54A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fc70a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fc70a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fc70a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fc70a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,117 ---- + -- FC70A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This file simulates a generic complex integer support package, to be + -- used for tests covering generic formal packages. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + generic -- Complex integer abstraction. + type Int_Type is range <>; + package FC70A00 is + + -- Simulate a generic complex integer support package. Complex integers + -- are treated as coordinates in the Cartesian plane. + + + type Complex_Type is private; + + Zero : constant Complex_Type; -- (0,0). + One : constant Complex_Type; -- (1,0). + + + function "-" (Right : Complex_Type) -- Invert a complex + return Complex_Type; -- integer. + + function "+" (Left, Right : Complex_Type) -- Add two complex + return Complex_Type; -- integers. + + function "*" (Left, Right : Complex_Type) -- Multiply two complex + return Complex_Type; -- integers. + + function Reciprocal (Right : Complex_Type) -- Return the reciprocal + return Complex_Type; -- of a complex integer. + + function Complex (Real, Imag : Int_Type) -- Create a complex + return Complex_Type; -- integer. + + private + + type Complex_Type is record + Real : Int_Type; + Imag : Int_Type; + end record; + + Zero : constant Complex_Type := (Real => 0, Imag => 0); + One : constant Complex_Type := (Real => 1, Imag => 0); + + end FC70A00; + + + --==================================================================-- + + + package body FC70A00 is -- Complex integer abstraction. + + function Complex (Real, Imag : Int_Type) return Complex_Type is + begin + return ( (Real, Imag) ); + end Complex; + + --==============================================-- + + function "-" (Right : Complex_Type) return Complex_Type is + begin + return ( (-Right.Real, -Right.Imag) ); + end "-"; + + --==============================================-- + + function "+" (Left, Right : Complex_Type) return Complex_Type is + begin + return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) ); + end "+"; + + --==============================================-- + + function "*" (Left, Right : Complex_Type) return Complex_Type is + begin + return ( (Real => (Left.Real * Right.Real) - (Left.Imag * Right.Imag), + Imag => (Left.Imag * Right.Real) + (Left.Real * Right.Imag)) ); + end "*"; + + --==============================================-- + + function Reciprocal (Right : Complex_Type) return Complex_Type is + Denominator : Int_Type := Right.Real**2 + Right.Imag**2; + begin -- NOTE: Results are truncated. + return ( (Right.Real/Denominator, -Right.Imag/Denominator) ); + end Reciprocal; + + end FC70A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fc70b00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fc70b00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fc70b00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fc70b00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,133 ---- + -- FC70B00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation defines a generic list abstraction. List elements can + -- be of any (nonlimited) type. Lists are implemented as singly linked + -- lists. Access to list elements is sequential. For each list, pointers + -- are maintained to the first and last elements in the list, as well as + -- the next element to be accessed. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + generic -- List abstraction. + type Element_Type is private; -- List elems can be of any nonlimited type. + package FC70B00 is + + type List_Type is limited private; + + -- Return true if current element is last in the list. + function End_Of_List (L : List_Type) return Boolean; + + -- Read current element value; do NOT advance "current" pointer. + procedure View_Element (L : in List_Type; E : out Element_Type); + + -- Read from current element and advance "current" pointer. + procedure Read_Element (L : in out List_Type; E : out Element_Type); + + -- Write to current element and advance "current" pointer. + procedure Write_Element (L : in out List_Type; E : in Element_Type); + + -- Add element to end of list. + procedure Add_Element (L : in out List_Type; E : in Element_Type); + + -- Set "current" pointer to first list element. + procedure Reset (L : in out List_Type); + + private + + type Node_Type; + type Node_Pointer is access Node_Type; + + type Node_Type is record + Item : Element_Type; + Next : Node_Pointer; + end record; + + type List_Type is record + First : Node_Pointer; + Current : Node_Pointer; + Last : Node_Pointer; + end record; + + end FC70B00; + + + --==================================================================-- + + + package body FC70B00 is + + function End_Of_List (L : List_Type) return Boolean is + begin + return (L.Current = null); + end End_Of_List; + + + procedure View_Element (L : in List_Type; E : out Element_Type) is + begin + -- ... Error-checking code omitted for brevity. + E := L.Current.Item; -- Retrieve current element. + end View_Element; + + + procedure Read_Element (L : in out List_Type; E : out Element_Type) is + begin + -- ... Error-checking code omitted for brevity. + E := L.Current.Item; -- Retrieve current element. + L.Current := L.Current.Next; -- Advance "current" pointer. + end Read_Element; + + + procedure Write_Element (L : in out List_Type; E : in Element_Type) is + begin + -- ... Error-checking code omitted for brevity. + L.Current.Item := E; -- Write to current element. + L.Current := L.Current.Next; -- Advance "current" pointer. + end Write_Element; + + + procedure Add_Element (L : in out List_Type; E : in Element_Type) is + New_Node : Node_Pointer := new Node_Type'(E, null); + begin + if L.First = null then -- No elements in list, so add new + L.First := New_Node; -- element at beginning of list. + else + L.Last.Next := New_Node; -- Add new element at end of list. + end if; + L.Last := New_Node; -- Set last-in-list pointer. + end Add_Element; + + + procedure Reset (L : in out List_Type) is + begin + L.Current := L.First; -- Set "current" pointer to first + end Reset; -- list element. + + + end FC70B00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fc70c00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fc70c00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fc70c00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fc70c00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,100 ---- + -- FC70C00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation defines a generic list abstraction in two packages. + -- The first package declares the types, the second declares the + -- operations. List elements can be of any (nonlimited) type. Lists are + -- implemented as singly linked lists. Access to list elements is + -- sequential. For each list, pointers are maintained to the first and + -- last elements in the list, as well as the next element to be accessed. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + generic + type Element_Type is private; -- List elems may be of any nonlimited type. + package FC70C00_0 is -- List abstraction. + + type Node_Type; + type Node_Pointer is access Node_Type; + + type Node_Type is record + Item : Element_Type; + Next : Node_Pointer; + end record; + + type List_Type is record + First : Node_Pointer; + Current : Node_Pointer; + Last : Node_Pointer; + end record; + + end FC70C00_0; + + + --==================================================================-- + + + -- No body for FC70C00_0; + + + --==================================================================-- + + + with FC70C00_0; -- List abstraction. + generic + with package List_Mgr is new FC70C00_0 (<>); + package FC70C00_1 is -- Basic list operations. + + -- Return true if current element is last in the list. + function End_Of_List (L : List_Mgr.List_Type) return Boolean; + + -- Set "current" pointer to first list element. + procedure Reset (L : in out List_Mgr.List_Type); + + end FC70C00_1; + + + --==================================================================-- + + + package body FC70C00_1 is + + function End_Of_List (L : List_Mgr.List_Type) return Boolean is + use List_Mgr; -- Renders "=" directly visible. + begin + return (L.Current = null); + end End_Of_List; + + + procedure Reset (L : in out List_Mgr.List_Type) is + begin + L.Current := L.First; -- Set "current" pointer to first + end Reset; -- list element. + + end FC70C00_1; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fcndecl.ada gcc-3.4.0/gcc/testsuite/ada/acats/support/fcndecl.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fcndecl.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fcndecl.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,50 ---- + -- FCNDECL.ADA + -- + -- 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. + --* + -- + -- PACKAGE THAT MAY BE MODIFIED TO DECLARE FUNCTIONS THAT RETURN + -- VALUES USABLE FOR INITIALIZATION OF CONSTANTS IN PACKAGE SPPRT13. + + WITH SYSTEM; + PACKAGE FCNDECL IS + -- INSERT FUNCTION DECLARATIONS AS NEEDED. + + type Mem is array (1 .. 100) of Long_Long_Integer; + Var0: Mem; + Var1: Mem; + Var2: Mem; + + Var_Addr : constant System.Address := Var0'address; + Var_Addr1: constant System.Address := Var1'address; + Var_Addr2: constant System.Address := Var2'address; + + Ent0: Mem; + Ent1: Mem; + Ent2: Mem; + + Entry_Addr : constant System.Address := Ent0'address; + Entry_Addr1: constant System.Address := Ent0'address; + Entry_Addr2: constant System.Address := Ent0'address; + + END FCNDECL; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fd72a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fd72a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fd72a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fd72a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,84 ---- + -- FD72A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation provides a basis for testing package + -- System.Address_To_Access_Conversions + -- + -- TEST FILES: + -- The following files comprise this foundation: + -- + -- FD72A00.A + -- + -- CHANGE HISTORY: + -- 08 FEB 96 SAIC Initial version + -- + --! + + with Impdef; + with System.Storage_Elements; + package FD72A00 is + use System; + + subtype Number is System.Storage_Elements.Integer_Address; + + package Num_IO renames Impdef.Address_Value_IO; + + -- the following conversions To/From Hex are to prevent optimizers from + -- optimizing out the otherwise senseless identity conversions, and + -- given the unknown nature of the type Number, the Identity operations + -- provided in Report will not suffice to this cause. + + function Address_To_Hex( Adder: System.Address ) return String; + + function Hex_To_Address( Hex: access String ) return System.Address; + + end FD72A00; + + package body FD72A00 is + + function Address_To_Hex( Adder: System.Address ) return String is + S : String(1..64) + := "uninitializedDEFuninitializedDEFuninitializedDEFuninitializedDEF"; + DeBlank : Positive := S'First; + begin + Num_IO.Put( S, Number( System.Storage_Elements.To_Integer( Adder ) ), + Base => 16 ); + while S(DeBlank) = ' ' loop + DeBlank := DeBlank +1; + end loop; + return S(DeBlank..S'Last); + end Address_To_Hex; + + function Hex_To_Address( Hex: access String ) return System.Address is + The_Number : Number; + Tail : Natural; + begin + Num_IO.Get( Hex.all, The_Number, Tail ); + return System.Storage_Elements.To_Address( + System.Storage_Elements.Integer_Address( The_Number ) ); + end Hex_To_Address; + + end FD72A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fdb0a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fdb0a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fdb0a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fdb0a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,144 ---- + -- FDB0A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation provides the basis for testing package + -- System.Storage_Pools. It provides simple implementations of + -- Allocate and Deallocate that have the side effect of calling + -- TCTouch.Touch when they are called. + -- + -- CHANGE HISTORY: + -- 02 JUN 95 SAIC Initial version + -- 05 APR 96 SAIC Fixed header for 2.1 + -- 02 JUL 98 EDS Swapped Pool.Avail change with overflow check + --! + + ---------------------------------------------------------------- FDB0A00 + + with Report; + with System.Storage_Pools; + with System.Storage_Elements; + package FDB0A00 is + + type Stack_Heap( Water_Line: System.Storage_Elements.Storage_Count ) + is new System.Storage_Pools.Root_Storage_Pool with private; + + procedure Allocate( + Pool : in out Stack_Heap; + Storage_Address : out System.Address; + Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count; + Alignment : in System.Storage_Elements.Storage_Count); + + procedure Deallocate( + Pool : in out Stack_Heap; + Storage_Address : in System.Address; + Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count; + Alignment : in System.Storage_Elements.Storage_Count); + + function Storage_Size( Pool: in Stack_Heap ) + return System.Storage_Elements.Storage_Count; + + function TC_Largest_Request return System.Storage_Elements.Storage_Count; + + Pool_Overflow : exception; + + private + + type Data_Array is array(System.Storage_Elements.Storage_Count range <>) + of System.Storage_Elements.Storage_Element; + + type Stack_Heap( Water_Line: System.Storage_Elements.Storage_Count ) + is new System.Storage_Pools.Root_Storage_Pool with record + Data : Data_Array(1..Water_Line); + Avail : System.Storage_Elements.Storage_Count := 1; + end record; + + end FDB0A00; + + -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + + with TCTouch; + package body FDB0A00 is + + Largest_Request_On_Record : System.Storage_Elements.Storage_Count := 0; + + procedure Allocate( + Pool : in out Stack_Heap; + Storage_Address : out System.Address; + Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count; + Alignment : in System.Storage_Elements.Storage_Count) is + use type System.Storage_Elements.Storage_Offset; + begin + TCTouch.Touch('A'); --------------------------------------------------- A + + -- set the pointer to the next correctly aligned available address + Pool.Avail := Pool.Avail + + (Alignment - (Pool.Data(Pool.Avail)'Address mod Alignment)); + + -- check for overflow + if Pool.Avail + Size_In_Storage_Elements > Pool.Water_Line then + raise Pool_Overflow; + end if; + + -- set the resulting address to that address + Storage_Address := Pool.Data(Pool.Avail)'Address; + + -- update the housekeeping + Pool.Avail := Pool.Avail + Size_In_Storage_Elements; + Largest_Request_On_Record + := System.Storage_Elements.Storage_Count'Max(Largest_Request_On_Record, + Size_In_Storage_Elements); + exception + when Constraint_Error => raise Pool_Overflow; -- in case I missed an edge + end Allocate; + + procedure Deallocate( + Pool : in out Stack_Heap; + Storage_Address : in System.Address; + Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count; + Alignment : in System.Storage_Elements.Storage_Count) is + begin + TCTouch.Touch('D'); --------------------------------------------------- D + + -- for the purposes of validation, the simplest possible implementation + -- of Deallocate is shown below: + + null; + + end Deallocate; + + function Storage_Size( Pool: in Stack_Heap ) + return System.Storage_Elements.Storage_Count is + begin + TCTouch.Touch('S'); --------------------------------------------------- S + return Pool.Water_Line; + end Storage_Size; + + function TC_Largest_Request return System.Storage_Elements.Storage_Count is + begin + return Largest_Request_On_Record; + end TC_Largest_Request; + + end FDB0A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fdd2a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fdd2a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fdd2a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fdd2a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,149 ---- + -- FDD2A00.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. + -- + -- + -- FOUNDATION DESCRIPTION: + -- This foundation provides the basis for testing user-defined stream + -- attributes. It provides operations which count calls to stream + -- attributes. + -- + -- CHANGE HISTORY: + -- 30 JUL 2001 PHL Initial version. + -- 5 DEC 2001 RLB Reformatted for ACATS. + -- + + with Ada.Streams; + use Ada.Streams; + package FDD2A00 is + + type Kinds is (Read, Write, Input, Output); + type Counts is array (Kinds) of Natural; + + + type My_Stream (Size : Stream_Element_Count) is new Root_Stream_Type with + record + First : Stream_Element_Offset := 1; + Last : Stream_Element_Offset := 0; + Contents : Stream_Element_Array (1 .. Size); + end record; + + procedure Clear (Stream : in out My_Stream); + + procedure Read (Stream : in out My_Stream; + Item : out Stream_Element_Array; + Last : out Stream_Element_Offset); + + procedure Write (Stream : in out My_Stream; Item : in Stream_Element_Array); + + + generic + type T (<>) is limited private; + with procedure Actual_Write + (Stream : access Root_Stream_Type'Class; Item : T); + with function Actual_Input + (Stream : access Root_Stream_Type'Class) return T; + with procedure Actual_Read (Stream : access Root_Stream_Type'Class; + Item : out T); + with procedure Actual_Output + (Stream : access Root_Stream_Type'Class; Item : T); + package Counting_Stream_Ops is + + procedure Write (Stream : access Root_Stream_Type'Class; Item : T); + function Input (Stream : access Root_Stream_Type'Class) return T; + procedure Read (Stream : access Root_Stream_Type'Class; Item : out T); + procedure Output (Stream : access Root_Stream_Type'Class; Item : T); + + function Get_Counts return Counts; + + end Counting_Stream_Ops; + + end FDD2A00; + package body FDD2A00 is + + procedure Clear (Stream : in out My_Stream) is + begin + Stream.First := 1; + Stream.Last := 0; + end Clear; + + procedure Read (Stream : in out My_Stream; + Item : out Stream_Element_Array; + Last : out Stream_Element_Offset) is + begin + if Item'Length >= Stream.Last - Stream.First + 1 then + Item (Item'First .. Item'First + Stream.Last - Stream.First) := + Stream.Contents (Stream.First .. Stream.Last); + Last := Item'First + Stream.Last - Stream.First; + Stream.First := Stream.Last + 1; + else + Item := Stream.Contents (Stream.First .. + Stream.First + Item'Length - 1); + Last := Item'Last; + Stream.First := Stream.First + Item'Length; + end if; + end Read; + + procedure Write (Stream : in out My_Stream; + Item : in Stream_Element_Array) is + begin + Stream.Contents (Stream.Last + 1 .. Stream.Last + Item'Length) := Item; + Stream.Last := Stream.Last + Item'Length; + end Write; + + + package body Counting_Stream_Ops is + Cnts : Counts := (others => 0); + + procedure Write (Stream : access Root_Stream_Type'Class; Item : T) is + begin + Cnts (Write) := Cnts (Write) + 1; + Actual_Write (Stream, Item); + end Write; + + function Input (Stream : access Root_Stream_Type'Class) return T is + begin + Cnts (Input) := Cnts (Input) + 1; + return Actual_Input (Stream); + end Input; + + procedure Read (Stream : access Root_Stream_Type'Class; Item : out T) is + begin + Cnts (Read) := Cnts (Read) + 1; + Actual_Read (Stream, Item); + end Read; + + procedure Output (Stream : access Root_Stream_Type'Class; Item : T) is + begin + Cnts (Output) := Cnts (Output) + 1; + Actual_Output (Stream, Item); + end Output; + + function Get_Counts return Counts is + begin + return Cnts; + end Get_Counts; + + end Counting_Stream_Ops; + + end FDD2A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fxa5a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fxa5a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fxa5a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fxa5a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,121 ---- + -- FXA5A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation package contains constants and a function used in + -- the evaluation of the Generic Elementary Functions. + -- + -- CHANGE HISTORY: + -- 06 Mar 95 SAIC Initial prerelease version. + -- 03 Apr 95 SAIC Corrected error in context clause. + -- 12 Jun 95 SAIC Added procedure Dont_Optimize. Added New_Float + -- type, and overload of function + -- Result_Within_Range. + -- + --! + + with Ada.Numerics; + with Report; + + package FXA5A00 is + + -- Constants. + + Epsilon : constant Float := Float'Model_Epsilon; + Small : constant Float := Float'Model_Small; + Large : constant Float := Float'Safe_Last; + Minus_Large : constant Float := Float'Safe_First; + + Half_Pi : constant Float := Ada.Numerics.Pi / 2.0; + Two_Pi : constant Float := Ada.Numerics.Pi * 2.0; + + Floating_Delta : constant Float := 0.05; + One_Plus_Delta : constant Float := 1.0 + Floating_Delta; + One_Minus_Delta : constant Float := 1.0 - Floating_Delta; + Minus_One_Plus_Delta : constant Float := -1.0 + Floating_Delta; + Minus_One_Minus_Delta : constant Float := -1.0 - Floating_Delta; + + + type New_Float is new Float digits 6; + + function Result_Within_Range (Result : Float; + Expected_Result : Float; + Relative_Error : Float) return Boolean; + + function Result_Within_Range (Result : New_Float; + Expected_Result : Float; + Relative_Error : Float) return Boolean; + + -- This procedure is designed to defeat optimization attempts by an + -- implementation in cases where an exception is specifically raised + -- in a test to test a prescribed exception result condition. + -- The parameter Num is a unique identifier for location purposes within + -- the test. + + generic + type Eval_Type is digits <>; + procedure Dont_Optimize (Check_Result : Eval_Type; + Num : Integer); + + end FXA5A00; + + --- + + package body FXA5A00 is + + + function Result_Within_Range (Result : Float; + Expected_Result : Float; + Relative_Error : Float) return Boolean is + begin + return (Result <= Expected_Result + Relative_Error) and + (Result >= Expected_Result - Relative_Error); + end Result_Within_Range; + + + function Result_Within_Range (Result : New_Float; + Expected_Result : Float; + Relative_Error : Float) return Boolean is + begin + return (Float(Result) <= Expected_Result + Relative_Error) and + (Float(Result) >= Expected_Result - Relative_Error); + end Result_Within_Range; + + + procedure Dont_Optimize (Check_Result : Eval_Type; + Num : Integer) is + begin + -- Note that the use of Minus_Large here is simply as a "dummy" value, + -- designed to indicate use of the Check_Result parameter, and has no + -- pass/fail significance to any test using this procedure. + -- + if Float(Check_Result) = Minus_Large then + Report.Comment("Attempted Defeat of Optimization ONLY -- Not " & + "a cause for test failure! " & + "Result = Minus_Large, Case:" & Integer'Image(Num)); + end if; + end Dont_Optimize; + + end FXA5A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fxaca00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fxaca00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fxaca00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fxaca00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,144 ---- + -- FXACA00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation consists of type definitions and object declarations + -- used by tests of Stream_IO functionality. + -- Objects of both record types specified below (discriminated records + -- with defaults, and discriminated records w/o defaults that have the + -- discriminant included in a representation clause for the type) should + -- have their discriminants included in the stream when using 'Write + -- Likewise, discriminants should be extracted from the stream when + -- using 'Read. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- 02 May 96 SAIC Incorporated reviewer comments for ACVC 2.1. + -- + --! + + with ImpDef; + + package FXACA00 is + + type Origin_Type is (Foreign, Domestic); + + for Origin_Type'Size use 1; -- Forces objects of the type to be + -- representable in 1 bit, used in rep clause + -- below for Sales_Record_Type. + + type Product_Type (Manufacture : Origin_Type := Domestic) is + record + Item : String (1..8); + ID : Natural range 1..100; + case Manufacture is + when Foreign => + Importer : String (1..10); + when Domestic => + Distributor : String (1..10); + end case; + end record; + + + type Sales_Record_Type (Buyer : Origin_Type) is -- No default provided + record -- for the discriminant. + Name : String (1..6); + Sale_Item : Boolean := False; + case Buyer is + when Foreign => + Quantity_Discount : Boolean; + when Domestic => + Cash_Discount : Boolean; + end case; + end record; + + + String_Bits : constant := ImpDef.Char_Bits * 6 - 1; + + -- This discriminated record type has a representation clause that + -- includes the discriminant of the object of this type. + + for Sales_Record_Type use + record + Name at 0 range 0..String_Bits; + Sale_Item at ImpDef.Next_Storage_Slot range 0..0; + Buyer at ImpDef.Next_Storage_Slot range 1..1; + Quantity_Discount at ImpDef.Next_Storage_Slot range 2..2; + Cash_Discount at ImpDef.Next_Storage_Slot range 3..3; + end record; + + + type Timespan_Type is (Week, Month, Year); + + type Sales_Statistics_Type is + array (Timespan_Type) of natural range 0 .. 500; + + + -- Object Declarations + + + Product_01 : Product_Type := (Domestic, "Product1", 1, "Distrib 01"); + Product_02 : Product_Type (Manufacture => Foreign) := (Foreign, + "Product2", + 2, + "Importer02"); + Product_03 : Product_Type (Foreign) := (Manufacture => Foreign, + Item => "Product3", + ID => 3, + Importer => "Importer03"); + -- + + Sale_Count_01 : Integer := 2; + Sale_Count_02 : Integer := 0; + Sale_Count_03 : Integer := 3; + + -- + + Sale_Rec_01 : Sales_Record_Type (Domestic) := + (Domestic, "Buyer1", False, True); + Sale_Rec_02 : Sales_Record_Type (Domestic) := + (Domestic, "Buyer2", True, False); + + Sale_Rec_03 : Sales_Record_Type (Buyer => Foreign) := + (Buyer => Foreign, Name => "Buyer3", Sale_Item => True, + Quantity_Discount => True); + + Sale_Rec_04 : Sales_Record_Type (Foreign) := + (Foreign, "Buyer4", True, False); + Sale_Rec_05 : Sales_Record_Type (Buyer => Foreign) := (Foreign, + "Buyer5", + False, + False); + -- + + + Product_01_Stats : Sales_Statistics_Type := (2,4,8); + Product_02_Stats : Sales_Statistics_Type := (Week => 0, + Month => 5, + Year => 10); + Product_03_Stats : Sales_Statistics_Type := (3, 6, others => 12); + + + end FXACA00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fxacb00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fxacb00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fxacb00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fxacb00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,107 ---- + -- FXACB00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation consists of type definitions and object declarations + -- used by tests of Stream_IO functionality. + -- These types include an unconstrained array type, and a discriminated + -- record without a default discriminant, specifically chosen for use in + -- demonstrating the capabilities of 'Output and 'Input. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + package FXACB00 is + + type Customer_Type is (Residence, Apartment, Commercial); + type Electric_Usage_Type is range 0..100000; + type Months_In_Service_Type is range 1..12; + type Quarterly_Period_Type is (Spring, Summer, Autumn, Winter); + subtype Month_In_Quarter_Type is Positive range 1..3; + type Service_History_Type is + array (Quarterly_Period_Type range <>, Month_In_Quarter_Type range <>) + of Electric_Usage_Type; + + + type Service_Type (Customer : Customer_Type) is + record + Name : String (1..21); + Account_ID : Natural range 0..100; + case Customer is + when Residence | Apartment => + Low_Income_Credit : Boolean := False; + when Commercial => + Baseline_Allowance : Natural range 0..1000; + Quantity_Discount : Boolean := False; + end case; + end record; + + + -- Object Declarations + + + Customer1 : Service_Type (Residence) := + (Residence, "1221 Morningstar Lane", 44, False); + Customer2 : Service_Type (Apartment) := (Customer => Apartment, + Account_ID => 67, + Name => "15 South Front St. #8", + Low_Income_Credit => True); + Customer3 : Service_Type (Commercial) := (Commercial, + "12442 Central Avenue ", + 100, + Baseline_Allowance => 938, + Quantity_Discount => True); + + -- + + C1_Months : Months_In_Service_Type := 10; + C2_Months : Months_In_Service_Type := 2; + C3_Months : Months_In_Service_Type := 12; + + -- + + C1_Service_History : + Service_History_Type (Quarterly_Period_Type, Month_In_Quarter_Type) := + (Spring => (1 => 35, 2 => 39, 3 => 32), + Summer => (1 => 34, 2 => 33, 3 => 39), + Autumn => (1 => 45, 2 => 40, 3 => 38), + Winter => (1 => 53, 2 => 0, 3 => 0)); + + C2_Service_History : + Service_History_Type (Quarterly_Period_Type range Spring..Summer, + Month_In_Quarter_Type) := + (Spring => (23, 22, 0), Summer => (0, 0, 0)); + + C3_Service_History : + Service_History_Type (Quarterly_Period_Type, Month_In_Quarter_Type) := + (others => (others => 200)); + + -- + + Total_Customers_In_Service : constant Natural := 3; + + end FXACB00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fxacc00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fxacc00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fxacc00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fxacc00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,115 ---- + -- FXACC00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation consists of a tagged type definition and several + -- record extensions. Objects of each type have also been declared + -- and given initial values. + -- + -- Visual Description of Type Extensions: + -- + -- type Ticket_Request + -- | + -- _______________|_________________ + -- | | + -- | | + -- type Subscriber_Request type VIP_Request + -- | + -- | + -- type Last_Minute_Request + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + with Ada.Calendar; + + package FXACC00 is + + type Location_Type is (Backstage, Orchestra, Center, Back, Balcony); + type Quantity_Type is range 1 .. 100; + subtype Season_Ticket_Type is Positive range 1 .. 1750; + type VIP_Status_Type is (Mayor, City_Council, Visitor); + type Donation_Type is (To_Charity, To_Theatre, Personal); + + Show_Of_Appreciation : constant Boolean := True; + + type Ticket_Request is tagged + record + Location : Location_Type; + Number_Of_Tickets : Quantity_Type; + end record; + + + type Subscriber_Request is new Ticket_Request with + record + Subscription_Number : Season_Ticket_Type; + end record; + + + type VIP_Request is new Ticket_Request with + record + Rank : VIP_Status_Type; + end record; + + + type Last_Minute_Request (Special_Consideration : Boolean) + is new VIP_Request with + record + Time_of_Request : Ada.Calendar.Time; + case Special_Consideration is + when True => Donation : Donation_Type; + when False => null; + end case; + end record; + + + -- Object Declarations. + + + Box_Office_Request : Ticket_Request := + (Location => Back, + Number_Of_Tickets => 2); + + Summer_Subscription : Subscriber_Request := + (Ticket_Request'(Box_Office_Request) + with Subscription_Number => 567); + + Mayoral_Ticket_Request : VIP_Request := + (Location => Backstage, + Number_Of_Tickets => 6, + Rank => Mayor); + + Late_Request : Last_Minute_Request (Show_Of_Appreciation) := + (Special_Consideration => Show_Of_Appreciation, + Location => Orchestra, + Number_Of_Tickets => 2, + Rank => City_Council, + Time_Of_Request => Ada.Calendar.Clock, + Donation => To_Charity); + + + end FXACC00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fxc6a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fxc6a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fxc6a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fxc6a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,162 ---- + -- FXC6A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares various volatile and non-volatile types. Some + -- are by-reference types, and some allow pass-by-copy. + -- + -- CHANGE HISTORY: + -- 23 Jan 96 SAIC Initial version for ACVC 2.1. + -- 02 DEC 97 EDS Removed Pragma Volatile applied to composite types. + -- 27 AUG 99 RLB Repaired so Nonvolatile_Tagged really is + -- Nonvolatile. + --! + + package FXC6A00 is + + type Roman is ('I', 'V', 'X', 'L', 'C', 'D', 'M'); -- By-copy type. + + type Acc_Roman is access all Roman; + + + type Tagged_Type is tagged record -- By-reference type. + C: Natural; + end record; + + + type Volatile_Tagged is new Tagged_Type with record -- Volatile by-reference + R1: Roman; -- type. + end record; + pragma Volatile (Volatile_Tagged); + + type Acc_Volatile_Tagged is access all Volatile_Tagged; + + -- By-reference type. + type NonVolatile_Tagged is new Tagged_Type with record + R2: aliased Roman; + end record; + + + task type Task_Type is -- By-reference type. + entry Calculate (C: in out Natural); + end Task_Type; + + type Acc_Task_Type is access all Task_Type; + + + protected type Protected_Type is -- By-reference type. + procedure Op; + private + Count : Natural := 0; + end Protected_Type; + + + protected type Volatile_Protected is -- Volatile by-reference + procedure Handler; -- type. + pragma Interrupt_Handler (Handler); + + function Handled return Boolean; + private + Was_Handled : Boolean := False; + end Volatile_Protected; + pragma Volatile (Volatile_Protected); + + type Acc_Vol_Protected is access all Volatile_Protected; + + + type Record_Type is record -- Allows pass-by-copy. + C: String(1 .. 2); + end record; + + + type Volatile_Record is limited record -- Volatile by-reference + C: String(1 .. 2); -- type. + end record; + pragma Volatile (Volatile_Record); + + + type Composite_Type is record -- By-reference type. + C: Tagged_Type; + D: aliased Volatile_Tagged; -- Volatile component. + end record; + + + type Private_Type is private; -- By-reference type. + + + type Array_Type is array (1..3) of Tagged_Type; -- By-reference type. + pragma Volatile_Components (Array_Type); + + type Acc_Array_Type is access all Array_Type; + + + type Lim_Private_Type is limited private; -- By-copy type. + + private + + type Private_Type is new Tagged_Type with record + D: Character; + end record; + + + type Lim_Private_Type is new Integer; + + end FXC6A00; + + + --==================================================================-- + + + package body FXC6A00 is + + task body Task_Type is + begin + accept Calculate (C: in out Natural) do + C := C * 10; + end Calculate; + end Task_Type; + + + protected body Protected_Type is + procedure Op is + begin + Count := Count + 1; + end Op; + end Protected_Type; + + + protected body Volatile_Protected is + procedure Handler is + begin + Was_Handled := True; + end Handler; + + function Handled return Boolean is + begin + return Was_Handled; + end Handled; + end Volatile_Protected; + + end FXC6A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fxe2a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fxe2a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fxe2a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fxe2a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,90 ---- + -- FXE2A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation provides a Declared Pure package, a Shared Passive + -- package, a Remote Types package and a normal, unrestricted package. + -- + -- It is used by tests checking the interrelationship between the + -- categorized packages + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- + --! + + + --==================================================================== + + -- This is a DECLARED PURE package + -- + package FXE2A00_0 is + + pragma pure (FXE2A00_0); + + type Type_From_0 is (Red, Orange, Yellow); + + + end FXE2A00_0; + + + --==================================================================== + + -- This is a SHARED_PASSIVE package + -- + package FXE2A00_1 is + + + pragma shared_passive (FXE2A00_1); + + type Type_From_1 is (Blue, Indigo, Violet); + + end FXE2A00_1; + + + --==================================================================== + + -- This is a REMOTE TYPES package + -- + package FXE2A00_2 is + + pragma Remote_Types (FXE2A00_2); + + type Type_From_2 is (Red, Orange, Yellow, Green, Blue, Indigo, Violet); + + end FXE2A00_2; + + + --==================================================================== + + -- This is a NORMAL unrestricted package which has no categorization + -- + package FXE2A00_4 is + + type Type_From_4 is (Black, White); + + end FXE2A00_4; + + --==================================================================== diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fxf2a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fxf2a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fxf2a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fxf2a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,96 ---- + -- FXF2A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation declares supporting objects, types and a generic + -- function for testing decimal fixed point operations. + -- + -- The generic function contains a loop which steps through two arrays: + -- one of binary operations and one of operands. For each iteration, the + -- current operation is performed on the current operand and a variable + -- "Result" e.g.: + -- + -- Result := Operation(2)(Operand(3), Result); + -- + -- The result of each operation is cumulated in Result and returned to + -- the caller when the loop completes. + -- + -- CHANGE HISTORY: + -- 12 Mar 96 SAIC Prerelease version for ACVC 2.1. + -- + --! + + package FXF2A00 is + + Loop_Count : constant := 30000; -- # test iterations. + Optr_Count : constant := 6; -- # operations in op sequence. + Opnd_Count : constant := 5; -- # different operands. + + type Loop_Range is range 1 .. Loop_Count; -- range 1 .. 30000. + type Optr_Range is mod Optr_Count; -- range 0 .. 5. + type Opnd_Range is mod Opnd_Count; -- range 0 .. 4. + + + generic + + type Decimal_Fixed is delta <> digits <>; + + type Operator_Ptr is access + function (L, R : Decimal_Fixed) return Decimal_Fixed; + + type Operator_Table is array (Optr_Range) of Operator_Ptr; + type Operand_Table is array (Opnd_Range) of Decimal_Fixed; + + function Operations_Loop (Initial : Decimal_Fixed; + Operator: Operator_Table; + Operand : Operand_Table) return Decimal_Fixed; + + end FXF2A00; + + + --==================================================================-- + + + package body FXF2A00 is + + function Operations_Loop (Initial : Decimal_Fixed; + Operator: Operator_Table; + Operand : Operand_Table) return Decimal_Fixed is + + Result : Decimal_Fixed := Initial; -- Cumulator. + Optr_Index : Optr_Range := 0; -- Index into operations table. + Opnd_Index : Opnd_Range := 0; -- Index into operand table. + + begin + for Count in Loop_Range loop + Result := Operator(Optr_Index) (Result, Operand(Opnd_Index)); + Optr_Index := Optr_Index + 1; -- Modular addition. + Opnd_Index := Opnd_Index + 1; -- Modular addition. + end loop; + + return Result; + end Operations_Loop; + + end FXF2A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/fxf3a00.a gcc-3.4.0/gcc/testsuite/ada/acats/support/fxf3a00.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/fxf3a00.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/fxf3a00.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,330 ---- + -- FXF3A00.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- This foundation contains decimal data values, valid and invalid + -- Picture strings, and Edited Output result strings that will be used + -- in tests of Appendix F.3. + -- Note: In this foundation package, the effect of "Table Driven Data" + -- is achieved using a series of arrays to hold the various data items. + -- Since the data items (Picture strings, Edited Output) are often of + -- different lengths, the arrays are defined to contain pointers to + -- string values, thereby allowing the "tables" to hold string data of + -- different sizes. + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- 15 Feb 95 SAIC Picture string, decimal data, and edited_output + -- modifications. + -- 23 Feb 95 SAIC Picture string modification. + -- 10 Mar 95 SAIC Added explanatory comments. + -- 15 Nov 95 SAIC Corrected picture string for ACVC 2.0.1. + -- 06 Oct 96 SAIC Corrected invalid picture strings. + -- 13 Feb 97 PWB.CTA Deleted invalid picture string. + -- 17 Feb 97 PWB.CTA Added leading blank to two picture strings + --! + + with Ada.Text_IO.Editing; + + package FXF3A00 is + + Number_Of_NDP_Items : constant := 12; -- No Decimal Places. + Number_Of_2DP_Items : constant := 20; -- Two Decimal Places. + Number_Of_Valid_Strings : constant := 40; + Number_Of_FF_Strings : constant := 4; -- French Francs + Number_Of_DM_Strings : constant := 5; -- Deutchemarks + Number_Of_CHF_Strings : constant := 1; -- Swiss Francs + Number_Of_Foreign_Strings : constant := Number_Of_FF_Strings + + Number_Of_DM_Strings + + Number_Of_CHF_Strings; + Number_Of_Invalid_Strings : constant := 25; + Number_Of_Erroneous_Conditions : constant := 3; + Number_Of_Edited_Output_Strings : constant := 32; + + -- The following string is to be used as a picture string with length + -- beyond the maximum (Max_Picture_Length) that is supported by the + -- implementation. + + A_Picture_String_Too_Long : constant + String (1..Ada.Text_IO.Editing.Max_Picture_Length + 1) := (others => '9'); + + + type Str_Ptr is access String; + + type Decimal_Type_NDP is delta 1.0 digits 16; -- no decimal places + type Decimal_Type_2DP is delta 0.01 digits 16; -- two decimal places + + type Data_Array_Type_1 is array (Integer range <>) of Decimal_Type_NDP; + type Data_Array_Type_2 is array (Integer range <>) of Decimal_Type_2DP; + + + type Picture_String_Array_Type is + array (Integer range <>) of Str_Ptr; + + type Edited_Output_Results_Array_Type is + array (Integer range <>) of Str_Ptr; + + + + Data_With_NDP : Data_Array_Type_1 (1..Number_Of_NDP_Items) := + ( 1 => 1234.0, + 2 => 51234.0, + 3 => -1234.0, + 4 => 1234.0, + 5 => 1.0, + 6 => 0.0, + 7 => -10.0, + 8 => -1.0, + 9 => 1234.0, + 10 => 1.0, + 11 => 36.0, + 12 => 0.0 + ); + + + Data_With_2DP : Data_Array_Type_2 (1..Number_Of_2DP_Items) := + ( 1 => 123456.78, + 2 => 123456.78, + 3 => 0.0, + 4 => 0.20, + 5 => 123456.00, + 6 => -123456.78, + 7 => 123456.78, + 8 => -12.34, + 9 => 1.23, + 10 => 12.34, + + -- Items 11-20 are used with picture strings in evaluating use of + -- foreign currency symbols. + + 11 => 123456.78, + 12 => 123456.78, + 13 => 32.10, + 14 => -5432.10, + 15 => -1234.57, + 16 => 123456.78, + 17 => 12.34, + 18 => 12.34, + 19 => 1.23, + 20 => 12345.67 + ); + + + + Valid_Strings : Picture_String_Array_Type + (1..Number_Of_Valid_Strings) := + + -- Items 1-10 are used in conjunction with Data_With_2DP values + -- to produce edited output strings, as well as in tests of + -- function Valid. + + ( 1 => new String'("-###**_***_**9.99"), + 2 => new String'("-$**_***_**9.99"), + 3 => new String'("-$$$$$$.$$"), + 4 => new String'("-$$$$$$.$$"), + 5 => new String'("+BBBZZ_ZZZ_ZZZ.ZZ"), + 6 => new String'("--_---_---_--9"), + 7 => new String'("-$_$$$_$$$_$$9.99"), + 8 => new String'("<$$_$$$9.99>"), + 9 => new String'("$_$$9.99"), + 10 => new String'("$$9.99"), + + -- Items 11-22 are used in conjunction with Data_With_NDP values + -- to produce edited output strings. + + 11 => new String'("ZZZZ9"), + 12 => new String'("ZZZZ9"), + 13 => new String'("<#Z_ZZ9>"), + 14 => new String'("<#Z_ZZ9>"), + 15 => new String'("ZZZ.ZZ"), + 16 => new String'("ZZZ.ZZ"), + 17 => new String'("<###99>"), + 18 => new String'("ZZZZZ-"), + 19 => new String'("$$$$9"), + 20 => new String'("$$$$$"), + 21 => new String'("<###99>"), + 22 => new String'("$$$$9"), + + -- Items 23-40 are used in validation of the Valid, To_Picture, and + -- Pic_String subprograms of package Text_IO.Editing, and are not + -- used to generate edited output. + + 23 => new String'("zZzZzZzZzZzZzZzZzZ"), + 24 => new String'("999999999999999999"), + 25 => new String'("******************"), + 26 => new String'("$$$$$$$$$$$$$$$$$$"), + 27 => new String'("9999/9999B9999_999909999"), + 28 => new String'("+999999999999999999"), + 29 => new String'("-999999999999999999"), + 30 => new String'("999999999999999999+"), + 31 => new String'("999999999999999999-"), + 32 => new String'("<<<_<<<_<<<_<<<_<<<_<<9>"), + 33 => new String'("++++++++++++++++++++"), + 34 => new String'("--------------------"), + 35 => new String'("zZzZzZzZzZzZzZzZzZ.zZ"), + 36 => new String'("******************.99"), + 37 => new String'("$$$$$$$$$$$$$$$$$$.99"), + + -- The following string has length 30, which is the minimum value + -- that must be supported for Max_Picture_Length. + + 38 => new String'("9_999_999_999_999_999_999BB.99"), + 39 => new String'("<<<_<<<_<<<_<<<.99>"), + 40 => new String'("ZZZZZZZZZZZZZZZZZ+") + ); + + + + Foreign_Strings : Picture_String_Array_Type + (1..Number_Of_Foreign_Strings) := + + -- These strings are going to be used in conjunction with non-default + -- values for Currency string, Radix mark, and Separator in calls to + -- Image and Put, as well as in tests of function Valid. + + ( 1 => new String'("-###**_***_**9.99"), -- FF + 2 => new String'("-$**_***_**9.99"), -- FF + 3 => new String'("<###z_ZZ9.99>"), -- FF + 4 => new String'("<###Z_ZZ9.99>"), -- FF + 5 => new String'("<<<<_<<<.<<###>"), -- DM + 6 => new String'("-$_$$$_$$$_$$9.99"), -- DM + 7 => new String'("$z99.99"), -- DM + 8 => new String'("$$$9.99"), -- DM + 9 => new String'("$_$$9.99"), -- DM + 10 => new String'("###_###_##9.99") -- CHF + ); + + + + Invalid_Strings : Picture_String_Array_Type + (1..Number_Of_Invalid_Strings) := + -- + -- The RM references to the right of these invalid picture strings + -- indicates which of the composition constraints of picture strings + -- is violated by the particular string (and all following strings + -- until another reference is presented). However, certain strings + -- violate multiple of the constraints. + -- + ( 1 => new String'("<<<"), + 2 => new String'("<<>>"), + 3 => new String'("<<<9_B0/$DB"), + 4 => new String'("+BB"), + 5 => new String'("<-"), + 6 => new String'(" new String'(" new String'("< new String'("<<__DB"), + 10 => new String'("<<<++++_++-"), + 11 => new String'("-999.99>"), + 12 => new String'("+++9.99+"), + 13 => new String'("++++>>"), + 14 => new String'("->"), + 15 => new String'("++9-"), + 16 => new String'("---999999->"), + 17 => new String'("+++-"), + 18 => new String'("+++_+++_+.--"), + 19 => new String'("--B.BB+>"), + 20 => new String'("$$#$"), + 21 => new String'("#B$$$$"), + 22 => new String'("**Z"), + 23 => new String'("ZZZzzz*"), + 24 => new String'("9.99DB(2)"), + 25 => new String'(A_Picture_String_Too_Long) + ); + + + Edited_Output : Edited_Output_Results_Array_Type + (1..Number_Of_Edited_Output_Strings) := + + -- The following 10 edited output strings result from the first 10 + -- valid strings when used with the first 10 Data_With_2DP numeric + -- values. + ( 1 => new String'(" $***123,456.78"), + 2 => new String'(" $***123,456.78"), + 3 => new String'(" "), + 4 => new String'(" $.20"), + 5 => new String'("+ 123,456.00"), + 6 => new String'(" -123,457"), + 7 => new String'(" $123,456.78"), + 8 => new String'("( $12.34)"), + 9 => new String'(" $1.23"), + 10 => new String'("$12.34"), + + -- The following 10 edited output strings correspond to the 10 foreign + -- currency picture strings (the currency string is supplied at the + -- time of the call to Editing.Image or Editing.Put), when used in + -- conjunction with Data_With_2DP items 11-20 + + 11 => new String'(" FF***123.456,78"), + 12 => new String'(" FF***123.456,78"), + 13 => new String'(" FF 32,10 "), + 14 => new String'("( FF5.432,10)"), + 15 => new String'(" (1,234.57DM )"), + 16 => new String'(" DM123,456.78"), + 17 => new String'("DM 12.34"), + 18 => new String'(" DM12.34"), + 19 => new String'(" DM1.23"), + 20 => new String'(" CHF12,345.67"), + + -- The following 12 edited output strings correspond to the 12 + -- Data_With_NDP items formatted using Valid_String items 11-22. + -- This combination shows decimal data with no decimal places + -- formatted using picture strings. + + 21 => new String'(" 1234"), + 22 => new String'("51234"), + 23 => new String'("($1,234)"), + 24 => new String'(" $1,234 "), + 25 => new String'(" 1.00"), + 26 => new String'(" "), + 27 => new String'("( $10)"), + 28 => new String'(" 1-"), + 29 => new String'("$1234"), + 30 => new String'(" $1"), + 31 => new String'(" $36 "), + 32 => new String'(" $0") + ); + + + + -- The following data is used to create exception situations in tests of + -- the Edited Output capabilities of package Ada.Text_IO.Editing. The data + -- are not themselves erroneous, but will produce exceptions based on the + -- data/picture string combination used. + + Erroneous_Data : Data_Array_Type_2 (1..Number_Of_Erroneous_Conditions) := + ( 1 => 12.34, + 2 => -12.34, + 3 => 51234.0 + ); + + Erroneous_Strings : Picture_String_Array_Type + (1..Number_Of_Erroneous_Conditions) := + ( 1 => new String'("9.99"), + 2 => new String'("99.99"), + 3 => new String'("$$$$9") + ); + + end FXF3A00; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/impdef.a gcc-3.4.0/gcc/testsuite/ada/acats/support/impdef.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/impdef.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/impdef.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,371 ---- + -- IMPDEF.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. + --* + -- + -- DESCRIPTION: + -- This package provides tailorable entities for a particular + -- implementation. Each entity may be modified to suit the needs + -- of the implementation. Default values are provided to act as + -- a guide. + -- + -- The entities in this package are those which are used in at least + -- one core test. Entities which are used exclusively in tests for + -- annexes C-H are located in annex-specific child units of this package. + -- + -- CHANGE HISTORY: + -- 12 DEC 93 SAIC Initial PreRelease version + -- 02 DEC 94 SAIC Second PreRelease version + -- 16 May 95 SAIC Added constants specific to tests of the random + -- number generator. + -- 16 May 95 SAIC Added Max_RPC_Call_Time constant. + -- 17 Jul 95 SAIC Added Non_State_String constant. + -- 21 Aug 95 SAIC Created from existing IMPSPEC.ADA and IMPBODY.ADA + -- files. + -- 30 Oct 95 SAIC Added external name string constants. + -- 24 Jan 96 SAIC Added alignment constants. + -- 29 Jan 96 SAIC Moved entities not used in core tests into annex- + -- specific child packages. Adjusted commentary. + -- Renamed Validating_System_Programming_Annex to + -- Validating_Annex_C. Added similar Validating_Annex_? + -- constants for the other non-core annexes (D-H). + -- 01 Mar 96 SAIC Added external name string constants. + -- 21 Mar 96 SAIC Added external name string constants. + -- 02 May 96 SAIC Removed constants for draft test CXA5014, which was + -- removed from the tentative ACVC 2.1 suite. + -- Added constants for use with FXACA00. + -- 06 Jun 96 SAIC Added constants for wide character test files. + -- 11 Dec 96 SAIC Updated constants for wide character test files. + -- 13 Dec 96 SAIC Added Address_Value_IO + -- 13 Sep 99 RLB Added more external name string constants. + -- 16 Sep 99 RLB Corrected definition of Non_State_String constant. + -- + --! + + with Report; + with Ada.Text_IO; + with System.Storage_Elements; + + package ImpDef is + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- The following boolean constants indicate whether this validation will + -- include any of annexes C-H. The values of these booleans affect the + -- behavior of the test result reporting software. + -- + -- True means the associated annex IS included in the validation. + -- False means the associated annex is NOT included. + + Validating_Annex_C : constant Boolean := True; + -- ^^^^^ --- MODIFY HERE AS NEEDED + + Validating_Annex_D : constant Boolean := True; + -- ^^^^^ --- MODIFY HERE AS NEEDED + + Validating_Annex_E : constant Boolean := True; + -- ^^^^^ --- MODIFY HERE AS NEEDED + + Validating_Annex_F : constant Boolean := True; + -- ^^^^^ --- MODIFY HERE AS NEEDED + + Validating_Annex_G : constant Boolean := True; + -- ^^^^^ --- MODIFY HERE AS NEEDED + + Validating_Annex_H : constant Boolean := True; + -- ^^^^^ --- MODIFY HERE AS NEEDED + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- This is the minimum time required to allow another task to get + -- control. It is expected that the task is on the Ready queue. + -- A duration of 0.0 would normally be sufficient but some number + -- greater than that is expected. + + Minimum_Task_Switch : constant Duration := 0.001; + -- ^^^ --- MODIFY HERE AS NEEDED + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- This is the time required to activate another task and allow it + -- to run to its first accept statement. We are considering a simple task + -- with very few Ada statements before the accept. An implementation is + -- free to specify a delay of several seconds, or even minutes if need be. + -- The main effect of specifying a longer delay than necessary will be an + -- extension of the time needed to run the associated tests. + + Switch_To_New_Task : constant Duration := 0.001; + -- ^^^ -- MODIFY HERE AS NEEDED + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- This is the time which will clear the queues of other tasks + -- waiting to run. It is expected that this will be about five + -- times greater than Switch_To_New_Task. + + Clear_Ready_Queue : constant Duration := 1.1; + -- ^^^ --- MODIFY HERE AS NEEDED + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- Some implementations will boot with the time set to 1901/1/1/0.0 + -- When a delay of Delay_For_Time_Past is given, the implementation + -- guarantees that a subsequent call to Ada.Calendar.Time_Of(1901,1,1) + -- will yield a time that has already passed (for example, when used in + -- a delay_until statement). + + Delay_For_Time_Past : constant Duration := 0.001; + -- ^^^ --- MODIFY HERE AS NEEDED + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- Minimum time interval between calls to the time dependent Reset + -- procedures in Float_Random and Discrete_Random packages that is + -- guaranteed to initiate different sequences. See RM A.5.2(45). + + Time_Dependent_Reset : constant Duration := 0.001; + -- ^^^ --- MODIFY HERE AS NEEDED + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- Test CXA5013 will loop, trying to generate the required sequence + -- of random numbers. If the RNG is faulty, the required sequence + -- will never be generated. Delay_Per_Random_Test is a time-out value + -- which allows the test to run for a period of time after which the + -- test is failed if the required sequence has not been produced. + -- This value should be the time allowed for the test to run before it + -- times out. It should be long enough to allow multiple (independent) + -- runs of the testing code, each generating up to 1000 random + -- numbers. + + Delay_Per_Random_Test : constant Duration := 0.001; + -- ^^^ --- MODIFY HERE AS NEEDED + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- The time required to execute this procedure must be greater than the + -- time slice unit on implementations which use time slicing. For + -- implementations which do not use time slicing the body can be null. + + procedure Exceed_Time_Slice; + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- This constant must not depict a random number generator state value. + -- Using this string in a call to function Value from either the + -- Discrete_Random or Float_Random packages will result in + -- Constraint_Error or Program_Error (expected result in test CXA5012). + -- If there is no such string, set it to "**NONE**". + + Non_State_String : constant String := "By No Means A State"; + -- MODIFY HERE AS NEEDED --- ^^^^^^^^^^^^^^^^^^^ + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- This string constant must be a legal external tag value as used by + -- CD10001 for the type Some_Tagged_Type in the representation + -- specification for the value of 'External_Tag. + + External_Tag_Value : constant String := "implementation_defined"; + -- MODIFY HERE AS NEEDED --- ^^^^^^^^^^^^^^^^^^^^^^ + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- The following address constant must be a valid address to locate + -- the C program CD30005_1. It is shown here as a named number; + -- the implementation may choose to type the constant as appropriate. + + function Cd30005_Proc (X : Integer) return Integer; + pragma Import (C, Cd30005_Proc, "_cd30005_1"); + + pragma Linker_Options ("ACATS4GNATDIR/support/cd300051.o"); + + CD30005_1_Foreign_Address : constant System.Address:= Cd30005_Proc'Address; + + -- CD30005_1_Foreign_Address : constant System.Address:= + -- System.Storage_Elements.To_Address ( 16#0000_0000# ) + -- --MODIFY HERE AS REQUIRED --- ^^^^^^^^^^^^^ + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- The following string constant must be the external name resulting + -- from the C compilation of CD30005_1. The string will be used as an + -- argument to pragma Import. + + CD30005_1_External_Name : constant String := "_cd30005_1"; + -- MODIFY HERE AS NEEDED --- ^^^^^^^^^ + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- The following constants should represent the largest default alignment + -- value and the largest alignment value supported by the linker. + -- See RM 13.3(35). + + Max_Default_Alignment : constant := Standard'Maximum_Alignment; + -- ^ --- MODIFY HERE AS NEEDED + + Max_Linker_Alignment : constant := Standard'Maximum_Alignment; + -- ^ --- MODIFY HERE AS NEEDED + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- The following string constants must be the external names resulting + -- from the C compilation of CXB30040.C, CXB30060.C, CXB30130.C, and + -- CXB30131.C. The strings will be used as arguments to pragma Import. + + CXB30040_External_Name : constant String := "CXB30040"; + -- MODIFY HERE AS NEEDED --- ^^^^^^^^ + + CXB30060_External_Name : constant String := "CXB30060"; + -- MODIFY HERE AS NEEDED --- ^^^^^^^^ + + CXB30130_External_Name : constant String := "CXB30130"; + -- MODIFY HERE AS NEEDED --- ^^^^^^^^ + + CXB30131_External_Name : constant String := "CXB30131"; + -- MODIFY HERE AS NEEDED --- ^^^^^^^^ + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- The following string constants must be the external names resulting + -- from the COBOL compilation of CXB40090.CBL, CXB40091.CBL, and + -- CXB40092.CBL. The strings will be used as arguments to pragma Import. + + CXB40090_External_Name : constant String := "CXB40090"; + -- MODIFY HERE AS NEEDED --- ^^^^^^^^ + + CXB40091_External_Name : constant String := "CXB40091"; + -- MODIFY HERE AS NEEDED --- ^^^^^^^^ + + CXB40092_External_Name : constant String := "CXB40092"; + -- MODIFY HERE AS NEEDED --- ^^^^^^^^ + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- The following string constants must be the external names resulting + -- from the Fortran compilation of CXB50040.FTN, CXB50041.FTN, + -- CXB50050.FTN, and CXB50051.FTN. + -- + -- The strings will be used as arguments to pragma Import. + -- + -- Note that the use of these four string constants will be split between + -- two tests, CXB5004 and CXB5005. + + CXB50040_External_Name : constant String := "CXB50040"; + -- MODIFY HERE AS NEEDED --- ^^^^^^^^ + + CXB50041_External_Name : constant String := "CXB50041"; + -- MODIFY HERE AS NEEDED --- ^^^^^^^^ + + CXB50050_External_Name : constant String := "CXB50050"; + -- MODIFY HERE AS NEEDED --- ^^^^^^^^ + + CXB50051_External_Name : constant String := "CXB50051"; + -- MODIFY HERE AS NEEDED --- ^^^^^^^^ + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- The following constants have been defined for use with the + -- representation clause in FXACA00 of type Sales_Record_Type. + -- + -- Char_Bits should be an integer at least as large as the number + -- of bits needed to hold a character in an array. + -- A value of 6 * Char_Bits will be used in a representation clause + -- to reserve space for a six character string. + -- + -- Next_Storage_Slot should indicate the next storage unit in the record + -- representation clause that does not overlap the storage designated for + -- the six character string. + + Char_Bits : constant := 8; + -- MODIFY HERE AS NEEDED ---^ + + Next_Storage_Slot : constant := 6; + -- MODIFY HERE AS NEEDED ---^ + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- The following string constant must be the path name for the .AW + -- files that will be processed by the Wide Character processor to + -- create the C250001 and C250002 tests. The Wide Character processor + -- will expect to find the files to process at this location. + + Test_Path_Root : constant String := + "ACATS4GNATDIR/tests/c2/"; + -- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ --- MODIFY HERE AS NEEDED + + -- The following two strings must not be modified unless the .AW file + -- names have been changed. The Wide Character processor will use + -- these strings to find the .AW files used in creating the C250001 + -- and C250002 tests. + + Wide_Character_Test : constant String := Test_Path_Root & "c250001"; + Upper_Latin_Test : constant String := Test_Path_Root & "c250002"; + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- The following instance of Integer_IO or Modular_IO must be supplied + -- in order for test CD72A02 to compile correctly. + -- Depending on the choice of base type used for the type + -- System.Storage_Elements.Integer_Address; one of the two instances will + -- be correct. Comment out the incorrect instance. + + -- package Address_Value_IO is + -- new Ada.Text_IO.Integer_IO(System.Storage_Elements.Integer_Address); + + package Address_Value_IO is + new Ada.Text_IO.Modular_IO(System.Storage_Elements.Integer_Address); + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + One_Second : constant Duration := 0.001; + + end ImpDef; + + + --==================================================================-- + + + package body ImpDef is + + -- NOTE: These are example bodies. It is expected that implementors + -- will write their own versions of these routines. + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- The time required to execute this procedure must be greater than the + -- time slice unit on implementations which use time slicing. For + -- implementations which do not use time slicing the body can be null. + + Procedure Exceed_Time_Slice is + T : Integer := 0; + Loop_Max : constant Integer := 4_000; + begin + for I in 1..Loop_Max loop + T := Report.Ident_Int (1) * Report.Ident_Int (2); + end loop; + end Exceed_Time_Slice; + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + end ImpDef; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/impdefd.a gcc-3.4.0/gcc/testsuite/ada/acats/support/impdefd.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/impdefd.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/impdefd.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,69 ---- + -- IMPDEFD.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. + --* + -- + -- DESCRIPTION: + -- This package provides tailorable entities for a particular + -- implementation. Each entity may be modified to suit the needs + -- of the implementation. Default values are provided to act as + -- a guide. + -- + -- The entities in this package are those which are used exclusively + -- in tests for Annex D (Real-Time Systems). + -- + -- APPLICABILITY CRITERIA: + -- This package is only required for implementations validating the + -- Real-Time Systems Annex. + -- + -- CHANGE HISTORY: + -- 29 Jan 96 SAIC Initial version for ACVC 2.1. + -- 27 Aug 98 EDS Removed Processor_Type value Time_Slice + --! + + package ImpDef.Annex_D is + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- This constant is the maximum storage size that can be specified + -- for a task. A single task that has this size must be able to + -- run. Ideally, this value is large enough that two tasks of this + -- size cannot run at the same time. If the value is too small then + -- test CXDC001 may take longer to run. See the test for further + -- information. + + Maximum_Task_Storage_Size : constant := 16_000_000; + -- ^^^^^^^^^^ --- MODIFY HERE AS NEEDED + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- Indicates the type of processor on which the tests are running. + + type Processor_Type is (Uni_Processor, Multi_Processor); + + Processor : constant Processor_Type := Uni_Processor; + -- ^^^^^^^^^^^ --- MODIFY HERE AS NEEDED + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + end ImpDef.Annex_D; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/impdefe.a gcc-3.4.0/gcc/testsuite/ada/acats/support/impdefe.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/impdefe.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/impdefe.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,58 ---- + -- IMPDEFE.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. + --* + -- + -- DESCRIPTION: + -- This package provides tailorable entities for a particular + -- implementation. Each entity may be modified to suit the needs + -- of the implementation. Default values are provided to act as + -- a guide. + -- + -- The entities in this package are those which are used exclusively + -- in tests for Annex E (Distributed Systems). + -- + -- APPLICABILITY CRITERIA: + -- This package is only required for implementations validating the + -- Distributed Systems Annex. + -- + -- CHANGE HISTORY: + -- 29 Jan 96 SAIC Initial version for ACVC 2.1. + -- + --! + + package ImpDef.Annex_E is + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- The Max_RPC_Call_Time value is the longest time a test needs to wait for + -- an RPC to complete. Included in this time is the time for the called + -- procedure to make a task entry call where the task is ready to accept + -- the call. + + Max_RPC_Call_Time : constant Duration := 2.0; + -- ^^^ --- MODIFY HERE AS NEEDED + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + end ImpDef.Annex_E; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/impdefg.a gcc-3.4.0/gcc/testsuite/ada/acats/support/impdefg.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/impdefg.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/impdefg.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,83 ---- + -- IMPDEFG.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. + --* + -- + -- DESCRIPTION: + -- This package provides tailorable entities for a particular + -- implementation. Each entity may be modified to suit the needs + -- of the implementation. Default values are provided to act as + -- a guide. + -- + -- The entities in this package are those which are used exclusively + -- in tests for Annex G (Numerics). + -- + -- APPLICABILITY CRITERIA: + -- This package is only required for implementations validating the + -- Numerics Annex. + -- + -- CHANGE HISTORY: + -- 29 Jan 96 SAIC Initial version for ACVC 2.1. + -- + --! + + package ImpDef.Annex_G is + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- This function must return a "negative zero" value for implementations + -- for which Float'Signed_Zeros is True. + + function Negative_Zero return Float; + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + end ImpDef.Annex_G; + + + --==================================================================-- + + + package body ImpDef.Annex_G is + + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + -- This function must return a negative zero value for implementations + -- for which Float'Signed_Zeros is True. + -- We generate the smallest normalized negative number, and divide by a + -- few powers of two to obtain a number whose absolute value equals zero + -- but whose sign is negative. + + function Negative_Zero return Float is + negz : float := -1.0 * + float (float'Machine_Radix) + ** ( Float'Machine_Emin - Float'Machine_Mantissa); + begin + return negz / 8.0; + end Negative_Zero; + + --=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-=====-- + + end ImpDef.Annex_G; + diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/impdefh.a gcc-3.4.0/gcc/testsuite/ada/acats/support/impdefh.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/impdefh.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/impdefh.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,102 ---- + -- IMPDEFH.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. + --* + -- + -- DESCRIPTION: + -- This package is used to define those values that are implementation + -- defined for use with validating the Safety and Security special needs + -- annex, Annex-H. + -- + -- APPLICABILITY CRITERIA: + -- This package is only required for implementations validating the + -- Safety and Security Annex. + -- + -- CHANGE HISTORY: + -- 13 FEB 96 SAIC Initial version + -- 25 NOV 96 SAIC Revised for release 2.1 + -- + --! + + package Impdef.Annex_H is + + type Scalar_To_Normalize is + ( Id0, Id1, Id2, Id3, Id4, Id5, Id6, Id7, Id8, Id9, + Id10, Id11, Id12, Id13, Id14, Id15, Id16, Id17, Id18, Id19, + Id20, Id21, Id22, Id23, Id24, Id25, Id26, Id27, Id28, Id29, + Id30, Id31, Id32, Id33, Id34, Id35, Id36, Id37, Id38, Id39, + Id40, Id41, Id42, Id43, Id44, Id45, Id46, Id47, Id48, Id49, + Id50, Id51, Id52, Id53, Id54, Id55, Id56, Id57, Id58, Id59, + Id60, Id61, Id62, Id63, Id64, Id65, Id66, Id67, Id68, Id69, + Id70, Id71, Id72, Id73, Id74, Id75, Id76, Id77, Id78, Id79, + Id80, Id81, Id82, Id83, Id84, Id85, Id86, Id87, Id88, Id89, + Id90, Id91, Id92, Id93, Id94, Id95, Id96, Id97, Id98, Id99, + IdA0, IdA1, IdA2, IdA3, IdA4, IdA5, IdA6, IdA7, IdA8, IdA9, + IdB0, IdB1, IdB2, IdB3, IdB4, IdB5, IdB6 ); + + -- NO MODIFICATION NEEDED TO TYPE SCALAR_TO_NORMALIZE. DO NOT MODIFY. + + type Small_Number is range 1..100; + + -- NO MODIFICATION NEEDED TO TYPE SMALL_NUMBER. DO NOT MODIFY. + + --===================================================================== + -- When the value documented in H.1(5) as the predictable initial value + -- for an uninitialized object of the type Scalar_To_Normalize + -- (an enumeration type containing 127 identifiers) is to be in the range + -- Id0..IdB6, set the following constant to True; otherwise leave it set + -- to False. + + Default_For_Scalar_To_Normalize_Is_In_Range : constant Boolean := False; + -- MODIFY HERE AS NEEDED --- ^^^^^ + + --===================================================================== + -- If the above constant Default_For_Scalar_To_Normalize_Is_In_Range is + -- set True, the following constant must be set to the value documented + -- in H.1(5) as the predictable initial value for the type + -- Scalar_To_Normalize. + + Default_For_Scalar_To_Normalize : constant Scalar_To_Normalize := Id0; + -- MODIFY HERE AS NEEDED --- ^^^ + + --===================================================================== + -- When the value documented in H.1(5) as the predictable initial value + -- for an uninitialized object of the type Small_Number + -- (an integer type containing 100 values) is to be in the range + -- 1..100, set the following constant to True; otherwise leave it set + -- to False. + + Default_For_Small_Number_Is_In_Range : constant Boolean := False; + -- MODIFY HERE AS NEEDED --- ^^^^^ + + --===================================================================== + -- If the above constant Default_For_Small_Number_Is_In_Range is + -- set True, the following constant must be set to the value documented + -- in H.1(5) as the predictable initial value for the type Small_Number. + + Default_For_Small_Number : constant Small_Number := 100; + -- MODIFY HERE AS NEEDED --- ^^^ + + --===================================================================== + + end Impdef.Annex_H; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/lencheck.ada gcc-3.4.0/gcc/testsuite/ada/acats/support/lencheck.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/support/lencheck.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/lencheck.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,60 ---- + -- THIS GENERIC PROCEDURE IS INTENDED FOR USE IN CONJUNCTION WITH THE + -- ACVC CHAPTER 13 C TESTS. IT IS INSTANTIATED FOR A TYPE WHOSE + -- REPRESENTATION IS TO BE CHECKED, AND THEN THE PROCEDURE REP_CHECK + -- IS CALLED WITH TWO ARGUMENTS, THE FIRST IS A VALUE OF THE TYPE TO + -- BE CHECKED, AND THE SECOND IS A STRING DESCRIBING OR NAMING THE + -- TYPE (FOR USE IN A CALL TO FAILED IF THE REPRESENTATION CHECK FAILS) + + -- THE CHECK IS TO CONVERT THE VALUE TO A PACKED BOOLEAN ARRAY WITH A + -- LENGTH CORRESPONDING TO THE 'SIZE OF THE TYPE, AND THEN CONVERT IT + -- BACK AGAIN AND CHECK THAT THE SAME VALUE IS OBTAINED. THE + -- CONVERSIONS ARE PERFORMED USING APPROPRIATE INSTANTIATIONS OF + -- UNCHECKED_CONVERSION. + + -- AUTHOR: ROBERT B. K. DEWAR, UNCOPYRIGHTED, PUBLIC DOMAIN USE + -- AUTHORIZED + -- DHH 03/27/89 CHANGED REP_CHECK TO LENGTH_CHECK BY ADDING A THIRD + -- PARAMETER TO GIVE LENGTH EXPECTED AND BY DOING A BIT TO + -- BIT COPY OF THE UNCHECKED CONVERSION BOOLEAN ARRAY SO + -- A STRAIGHT COMPARE OF THE TWO VALUES CAN BE DONE. + + GENERIC + + TYPE TEST_TYPE IS PRIVATE; + + PROCEDURE LENGTH_CHECK (TEST_VALUE : TEST_TYPE; + EXPECTED_LENGTH : INTEGER; + TYPE_ID : STRING); + + WITH UNCHECKED_CONVERSION; + WITH REPORT; USE REPORT; + + PROCEDURE LENGTH_CHECK (TEST_VALUE : TEST_TYPE; + EXPECTED_LENGTH : INTEGER; + TYPE_ID : STRING) IS + LEN : CONSTANT INTEGER := EXPECTED_LENGTH; + TYPE BIT_ARRAY_TYPE IS ARRAY (1 .. LEN) OF BOOLEAN; + PRAGMA PACK (BIT_ARRAY_TYPE); + TYPE NEW_BIT_ARRAY_TYPE IS ARRAY (1 .. 3) OF BIT_ARRAY_TYPE; + + FUNCTION TO_BITS IS NEW UNCHECKED_CONVERSION (TEST_TYPE, + BIT_ARRAY_TYPE); + FUNCTION FROM_BITS IS NEW UNCHECKED_CONVERSION (BIT_ARRAY_TYPE, + TEST_TYPE); + + BIT_ARRAY : BIT_ARRAY_TYPE := (OTHERS => FALSE); + + BIT_ARRAY_NEW : NEW_BIT_ARRAY_TYPE := (OTHERS => (OTHERS => FALSE)); + BEGIN + + BIT_ARRAY := TO_BITS (TEST_VALUE); + + FOR I IN 1 .. LEN LOOP + BIT_ARRAY_NEW(IDENT_INT(1)) (IDENT_INT(I)) := BIT_ARRAY(I); + END LOOP; + + IF TEST_VALUE /= FROM_BITS (BIT_ARRAY_NEW(1)) THEN + FAILED ("CHECK ON REPRESENTATION FOR " & TYPE_ID & " FAILED."); + END IF; + + END LENGTH_CHECK; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/macrodef.adb gcc-3.4.0/gcc/testsuite/ada/acats/support/macrodef.adb *** gcc-3.3.3/gcc/testsuite/ada/acats/support/macrodef.adb 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/macrodef.adb 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,11 ---- + with Ada.Text_IO; + with System; + procedure Macrodef is + begin + Ada.Text_IO.Put_Line ("Integer'First = " & Integer'Image (Integer'First)); + Ada.Text_IO.Put_Line ("Integer'Last = " & Integer'Image (Integer'Last)); + Ada.Text_IO.Put_Line ("System.Min_Int = " & Long_Long_Integer'Image (System.Min_Int)); + Ada.Text_IO.Put_Line ("System.Max_Int = " & Long_Long_Integer'Image (System.Max_Int)); + Ada.Text_IO.Put_Line ("Ada.Text_IO.Count'Last = " & Ada.Text_IO.Count'Image (Ada.Text_IO.Count'Last)); + Ada.Text_IO.Put_Line ("Ada.Text_IO.Field'Last = " & Ada.Text_IO.Field'Image (Ada.Text_IO.Field'Last)); + end Macrodef; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/macro.dfs gcc-3.4.0/gcc/testsuite/ada/acats/support/macro.dfs *** gcc-3.3.3/gcc/testsuite/ada/acats/support/macro.dfs 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/macro.dfs 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,301 ---- + -- MACRO.DFS + -- THIS FILE CONTAINS THE MACRO DEFINITIONS USED IN THE ACVC TESTS. + -- THESE DEFINITIONS ARE USED BY THE ACVC TEST PRE-PROCESSOR, + -- MACROSUB. MACROSUB WILL CALCULATE VALUES FOR THOSE MACRO SYMBOLS + -- WHOSE DEFINITIONS DEPEND ON THE VALUE OF MAX_IN_LEN (NAMELY, THE + -- VALUES OF THE MACRO SYMBOLS BIG_ID1, BIG_ID2, BIG_ID3, BIG_ID4, + -- BIG_STRING1, BIG_STRING2, MAX_STRING_LITERAL, BIG_INT_LIT, BIG_REAL_LIT, + -- AND BLANKS). THEREFORE, ANY VALUES GIVEN IN THIS FILE FOR THOSE + -- MACRO SYMBOLS WILL BE IGNORED BY MACROSUB. + + -- NOTE: AS REQUIRED BY THE MACROSUB PROGRAM, THE FIRST MACRO DEFINED + -- IN THIS FILE IS $MAX_IN_LEN. THE NEXT 5 MACRO DEFINITIONS + -- ARE FOR THOSE MACRO SYMBOLS THAT DEPEND ON THE VALUE OF + -- MAX_IN_LEN. THESE ARE IN ALPHABETIC ORDER. FOLLOWING THESE + -- ARE 36 MORE DEFINITIONS, ALSO IN ALPHABETIC ORDER. + + -- EACH DEFINITION IS ACCORDING TO THE FOLLOWING FORMAT: + + -- A. A NUMBER OF LINES PRECEDED BY THE ADA COMMENT DELIMITER, --. + -- THE FIRST OF THESE LINES CONTAINS THE MACRO SYMBOL AS IT APPEARS + -- IN THE TEST FILES (WITH THE DOLLAR SIGN). THE NEXT FEW "COMMENT" + -- LINES CONTAIN A DESCRIPTION OF THE VALUE TO BE SUBSTITUTED. + -- THE REMAINING "COMMENT" LINES, THE FIRST OF WHICH BEGINS WITH THE + -- WORDS "USED IN: " (NO QUOTES), CONTAIN A LIST OF THE TEST FILES + -- (WITHOUT THE .TST EXTENSION) IN WHICH THE MACRO SYMBOL APPEARS. + -- EACH TEST FILE NAME IS PRECEDED BY ONE OR MORE BLANKS. + -- B. A LINE, WITHOUT THE COMMENT DELIMITER, CONSISTING OF THE + -- IDENTIFIER (WITHOUT THE DOLLAR SIGN) OF THE MACRO SYMBOL, + -- FOLLOWED BY A SPACE OR TAB, FOLLOWED BY THE VALUE TO BE + -- SUBSTITUTED. IN THE DISTRIBUTION FILE, A SAMPLE VALUE IS + -- PROVIDED; THIS VALUE MUST BE REPLACED BY A VALUE APPROPRIATE TO + -- THE IMPLEMENTATION. + + -- DEFINITIONS ARE SEPARATED BY ONE OR MORE EMPTY LINES. + -- THE LIST OF DEFINITIONS BEGINS AFTER THE FOLLOWING EMPTY LINE. + + -- $MAX_IN_LEN + -- AN INTEGER LITERAL GIVING THE MAXIMUM LENGTH PERMITTED BY THE + -- COMPILER FOR A LINE OF ADA SOURCE CODE (NOT INCLUDING AN END-OF-LINE + -- CHARACTER). + -- USED IN: A26007A + MAX_IN_LEN 200 + + -- $MAX_STRING_LITERAL + -- A STRING LITERAL CONSISTING OF $MAX_IN_LEN CHARACTERS (INCLUDING THE + -- QUOTE CHARACTERS). + -- USED IN: A26007A + MAX_STRING_LITERAL "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" + + -- $BIG_ID1 + -- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN. + -- THE MACROSUB PROGRAM WILL SUPPLY AN IDENTIFIER IN WHICH THE + -- LAST CHARACTER IS '1' AND ALL OTHERS ARE 'A'. + -- USED IN: C23003A C23003B C23003G C23003I + -- C35502D C35502F + BIG_ID1 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA1 + + -- $BIG_ID2 + -- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN, + -- DIFFERING FROM $BIG_ID1 ONLY IN THE LAST CHARACTER. THE MACROSUB + -- PROGRAM WILL USE '2' AS THE LAST CHARACTER. + -- USED IN: C23003A C23003B B23003F C23003G C23003I + BIG_ID2 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2 + + -- $BIG_ID3 + -- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN. + -- MACROSUB WILL USE '3' AS THE "MIDDLE" CHARACTER; ALL OTHERS ARE 'A'. + -- USED IN: C23003A C23003B C23003G C23003I + BIG_ID3 AAAAAAAAAAAAAAAAAAAAAAAAAAAAA3AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + + -- $BIG_ID4 + -- AN IDENTIFIER IN WHICH THE NUMBER OF CHARACTERS IS $MAX_IN_LEN, + -- DIFFERING FROM $BIG_ID3 ONLY IN THE MIDDLE CHARACTER. MACROSUB + -- WILL USE '4' AS THE MIDDLE CHARACTER. + -- USED IN: C23003A C23003B C23003G C23003I + BIG_ID4 AAAAAAAAAAAAAAAAAAAAAAAAAAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + + -- $BIG_STRING1 + -- A STRING LITERAL (WITH QUOTES) WHOSE CATENATION WITH $BIG_STRING2 + -- ($BIG_STRING1 & $BIG_STRING2) PRODUCES THE IMAGE OF $BIG_ID1. + -- USED IN: C35502D C35502F + BIG_STRING1 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" + + -- $BIG_STRING2 + -- A STRING LITERAL (WITH QUOTES) WHOSE CATENATION WITH $BIG_STRING1 + -- ($BIG_STRING1 & $BIG_STRING2) PRODUCES THE IMAGE OF $BIG_ID1. + -- USED IN: C35502D C35502F + BIG_STRING2 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAA1" + + -- $BLANKS + -- A SEQUENCE OF ($MAX_IN_LEN - 20) BLANKS. + -- USED IN: B22001A B22001B B22001C B22001D B22001E B22001F + -- B22001G B22001I B22001J B22001K B22001L B22001M + -- B22001N + -- < LIMITS OF SAMPLE SHOWN BY ANGLE BRACKETS > + BLANKS + + -- $ACC_SIZE + -- AN INTEGER LITERAL WHOSE VALUE IS THE MINIMUM NUMBER OF BITS + -- SUFFICIENT TO HOLD ANY VALUE OF AN ACCESS TYPE. + -- USED IN: CD2A83C BD2A02A + ACC_SIZE 32 + + -- $ALIGNMENT + -- A VALUE THAT IS LEGITIMATE FOR USE IN A RECORD ALIGNMENT CLAUSE. + -- USED IN: CD4041A BD4006A + ALIGNMENT 4 + + -- $COUNT_LAST + -- AN INTEGER LITERAL WHOSE VALUE IS TEXT_IO.COUNT'LAST. + -- USED IN: CE3002B + COUNT_LAST 2147483647 + + -- $ENTRY_ADDRESS + -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY + -- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION. + -- USED IN: SPPRT13SP + ENTRY_ADDRESS ENTRY_ADDR + + -- $ENTRY_ADDRESS1 + -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY + -- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION. THE ADDRESS + -- MUST BE DISTINCT FROM THAT USED IN $ENTRY_ADDRESS. + -- USED IN: SPPRT13SP + ENTRY_ADDRESS1 ENTRY_ADDR1 + + -- $ENTRY_ADDRESS2 + -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A TASK ENTRY + -- (I.E., FOR AN INTERRUPT) FOR THIS IMPLEMENTATION. THE ADDRESS + -- MUST BE DISTINCT FROM THOSE USED IN $ENTRY_ADDRESS + -- AND $ENTRY_ADDRESS1. + -- USED IN: SPPRT13SP + ENTRY_ADDRESS2 ENTRY_ADDR2 + + -- $FIELD_LAST + -- AN INTEGER LITERAL WHOSE VALUE IS TEXT_IO.FIELD'LAST. + -- USED IN: CE3002C + FIELD_LAST 255 + + -- $FORM_STRING + -- A STRING LITERAL SPECIFYING THAT THE EXTERNAL FILE MEETS BOTH + -- CONDITIONS: (1) THERE IS A VALUE OF TYPE TEXT_IO.COUNT THAT IS NOT + -- AN APPROPRIATE LINE-LENGTH FOR THE FILE, (2) THERE IS A VALUE + -- OF TYPE TEXT_IO.COUNT THAT IS NOT AN APPROPRIATE PAGE-LENGTH + -- FOR THE FILE. + -- IF IT IS NOT POSSIBLE TO SATISFY BOTH CONDITIONS, THEN SUBSTITUTE + -- A STRING LITERAL SPECIFYING THAT THE EXTERNAL FILE SATISFIES ONE + -- OF THE CONDITIONS. IF IT IS NOT POSSIBLE TO SATISFY EITHER CONDITION, + -- THEN SUBSTITUTE THE NULL STRING (""). + -- USED IN: CE3304A + FORM_STRING "" + + -- $FORM_STRING2 + -- A STRING LITERAL SPECIFYING THAT THE CAPACITY OF THE FILE IS + -- RESTRICTED TO 4096 CHARACTERS OR LESS. IF THE IMPLEMENTATION + -- CANNOT RESTRICT FILE CAPACITY, $FORM_STRING2 SHOULD EQUAL + -- "CANNOT_RESTRICT_FILE_CAPACITY". + -- USED IN: CE2203A CE2403A + FORM_STRING2 "CANNOT_RESTRICT_FILE_CAPACITY" + + -- $GREATER_THAN_DURATION + -- A REAL LITERAL WHOSE VALUE (NOT SUBJECT TO ROUND-OFF ERROR + -- IF POSSIBLE) LIES BETWEEN DURATION'BASE'LAST AND DURATION'LAST. IF + -- NO SUCH VALUES EXIST, USE A VALUE IN DURATION'RANGE. + -- USED IN: C96005B + GREATER_THAN_DURATION 86_000.0 + + + + + -- $ILLEGAL_EXTERNAL_FILE_NAME1 + -- AN ILLEGAL EXTERNAL FILE NAME (E.G., TOO LONG, CONTAINING INVALID + -- CHARACTERS, CONTAINING WILD-CARD CHARACTERS, OR SPECIFYING A + -- NONEXISTENT DIRECTORY). + -- USED IN: CE2102C CE2102H CE2103A CE2103B CE3102B CE3107A + ILLEGAL_EXTERNAL_FILE_NAME1 /NODIRECTORY/FILENAME + + -- $ILLEGAL_EXTERNAL_FILE_NAME2 + -- AN ILLEGAL EXTERNAL FILE NAME, DIFFERENT FROM $ILLEGAL_EXTERNAL_FILE_NAME1. + -- USED IN: CE2102C CE2102H CE2103A CE2103B CE3102B + ILLEGAL_EXTERNAL_FILE_NAME2 /@@/@@/@@\@@\@@\@@ + + -- $INAPPROPRIATE_LINE_LENGTH + -- A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE LINE-LENGTH + -- FOR THE EXTERNAL FILE. IF THERE IS NO SUCH VALUE, THEN USE -1. + -- USED IN: CE3304A + INAPPROPRIATE_LINE_LENGTH -1 + + -- $INAPPROPRIATE_PAGE_LENGTH + -- A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE PAGE-LENGTH + -- FOR THE EXTERNAL FILE. IF THERE IS NO SUCH VALUE, THEN USE -1. + -- USED IN: CE3304A + INAPPROPRIATE_PAGE_LENGTH -1 + + -- $INTEGER_FIRST + -- AN INTEGER LITERAL, WITH SIGN, WHOSE VALUE IS INTEGER'FIRST. + -- THE LITERAL MUST NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING + -- BLANKS. + -- USED IN: C35503F B54B01B + INTEGER_FIRST -2147483648 + + -- $INTEGER_LAST + -- AN INTEGER LITERAL WHOSE VALUE IS INTEGER'LAST. THE LITERAL MUST + -- NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING BLANKS. + -- USED IN: C35503F B54B01B + INTEGER_LAST 2147483647 + + + -- $LESS_THAN_DURATION + -- A REAL LITERAL (WITH SIGN) WHOSE VALUE (NOT SUBJECT TO + -- ROUND-OFF ERROR IF POSSIBLE) LIES BETWEEN DURATION'BASE'FIRST AND + -- DURATION'FIRST. IF NO SUCH VALUES EXIST, USE A VALUE IN + -- DURATION'RANGE. + -- USED IN: C96005B + LESS_THAN_DURATION -86_400.0 + + + -- $MACHINE_CODE_STATEMENT + -- A VALID MACHINE CODE STATEMENT AS SPECIFIED IN THE PACKAGE + -- MACHINE_CODE. IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE + -- CODE THEN USE THE ADA NULL STATEMENT (I.E. NULL; ). + -- USED IN: AD8011A BD8001A BD8002A BD8004A BD8004B + MACHINE_CODE_STATEMENT Asm_Insn'(Asm ("nop")); + + -- $MAX_INT + -- AN INTEGER LITERAL WHOSE VALUE IS SYSTEM.MAX_INT. + -- THE LITERAL MUST NOT INCLUDE UNDERSCORES OR LEADING OR TRAILING + -- BLANKS. + -- USED IN: C35503D C35503F C4A007A + MAX_INT 9223372036854775807 + + + -- $MIN_INT + -- AN INTEGER LITERAL, WITH SIGN, WHOSE VALUE IS SYSTEM.MIN_INT. + -- THE LITERAL MUST NOT CONTAIN UNDERSCORES OR LEADING OR TRAILING + -- BLANKS. + -- USED IN: C35503D C35503F + MIN_INT -9223372036854775808 + + -- $NAME + -- THE NAME OF A PREDEFINED INTEGER TYPE OTHER THAN INTEGER, + -- SHORT_INTEGER, OR LONG_INTEGER. + -- (IMPLEMENTATIONS WHICH HAVE NO SUCH TYPES SHOULD USE AN UNDEFINED + -- IDENTIFIER SUCH AS NO_SUCH_TYPE_AVAILABLE.) + -- USED IN: C45231D CD7101G + NAME LONG_LONG_INTEGER + + -- $OPTIONAL_DISC + -- A DISCRIMINANT USED AS THE DISCRIMINANT PART OF $RECORD_NAME. + -- IF MACHINE CODE INSERTIONS ARE NOT SUPPORTED THEN SUBSTITUTE + -- NO_SUCH_MACHINE_CODE_DISC. + -- USED IN: BD8002A + OPTIONAL_DISC + + -- $RECORD_DEFINITION + -- THE RECORD TYPE DEFINITION (WITH FINAL SEMICOLON) FOR THE TYPE THAT + -- WAS USED IN THE MACRO $RECORD_NAME, AS DECLARED IN PACKAGE + -- MACHINE_CODE. IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE CODE, + -- THEN USE A NULL RECORD DEFINITION + -- USED IN: BD8002A + RECORD_DEFINITION RECORD ASM : STRING (1..4); END RECORD; + + -- $RECORD_NAME + -- A VALID RECORD TYPE NAME THAT IS DEFINED IN PACKAGE MACHINE_CODE. + -- IF THE IMPLEMENTATION DOES NOT SUPPORT MACHINE CODE THEN + -- USE THE NAME "NO_SUCH_MACHINE_CODE_TYPE" + -- USED IN: BD8002A + RECORD_NAME Asm_Insn + + -- $TASK_SIZE + -- AN INTEGER LITERAL WHOSE VALUE IS THE NUMBER OF BITS REQUIRED TO + -- HOLD A TASK OBJECT. + -- USED IN: CD2A91C + TASK_SIZE 32 + + -- $TASK_STORAGE_SIZE + -- THE NUMBER OF STORAGE UNITS REQUIRED FOR A TASK ACTIVATION. + -- USED IN: BD2C01D BD2C02A BD2C03A C87B62D CD1009K CD1009T + -- CD1009U CD1C03E CD1C06A CD2C11A CC1225A CD2C11D + TASK_STORAGE_SIZE 1024 + + -- $VARIABLE_ADDRESS + -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS + -- IMPLEMENTATION. + -- USED IN: SPPRT13SP + VARIABLE_ADDRESS VAR_ADDR + + -- $VARIABLE_ADDRESS1 + -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS + -- IMPLEMENTATION. THE ADDRESS MUST BE DISTINCT FROM THAT USED IN + -- THE MACRO $VARIABLE_ADDRESS. + -- USED IN: SPPRT13SP + VARIABLE_ADDRESS1 VAR_ADDR1 + + -- $VARIABLE_ADDRESS2 + -- AN EXPRESSION YIELDING A LEGAL ADDRESS FOR A VARIABLE FOR THIS + -- IMPLEMENTATION. THE ADDRESS MUST BE DISTINCT FROM THOSE USED IN + -- THE MACROS $VARIABLE_ADDRESS AND $VARIABLE_ADDRESS1. + -- USED IN: SPPRT13SP + VARIABLE_ADDRESS2 VAR_ADDR2 + diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/macrosub.ada gcc-3.4.0/gcc/testsuite/ada/acats/support/macrosub.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/support/macrosub.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/macrosub.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,548 ---- + -- MACROSUB.ADA + -- + -- 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. + --* + -- + ----------------------------------------------------------------------- + -- -- + -- THIS PROGRAM IS CALLED MACROSUB. IT IS USED TO REPLACE THE -- + -- MACROS IN THE ACVC TEST SUITE WITH THEIR PROPER VALUES. THE -- + -- STEPS LISTED BELOW SHOULD BE FOLLOWED TO ENSURE PROPER RUNNING -- + -- OF THE MACROSUB PROGRAM: -- + -- -- + -- 1) Edit the file MACRO.DFS (included with the testtape) -- + -- and insert your macro values. The macros which use -- + -- the value of MAX_IN_LEN are calculated automatically -- + -- and do not need to be entered. -- + -- -- + -- 2) Create a file called TSTTESTS.DAT which includes all -- + -- of the .TST test file names and their directory -- + -- specifications, if necessary. If a different name -- + -- other than TSTTESTS.DAT is used, this name must be -- + -- substituted in the MACROSUB.ADA file. -- + -- -- + -- 3) Compile and link MACROSUB. -- + -- -- + -- 4) Run the MACROSUB program. -- + -- -- + -- WHEN THE PROGRAM FINISHES RUNNING, THE MACROS WILL HAVE BEEN -- + -- REPLACED WITH THE APPROPRIATE VALUES FROM MACRO.DFS. -- + -- -- + -- -- + -- -- + -- HISTORY: -- + -- BCB 04/17/90 CHANGED MODE OF CALC_MAX_VALS TO OUT. CHANGED -- + -- VALUE OF MAX_VAL_LENGTH FROM 512 TO 400. ADDED -- + -- EXCEPTION HANDLER SO PROGRAM DOES NOT CRASH IF -- + -- AN EXCEPTION IS RAISED. ADDED MESSAGES TO -- + -- REPORT PROGRESS OF PROGRAM. CHANGED PROGRAM SO -- + -- IT DOES NOT ABORT IF A FILE CANNOT BE FOUND. -- + -- MODIFIED PROGRAM SO IT ACCEPTS FILENAMES WITH -- + -- VERSION NUMBERS. -- + ----------------------------------------------------------------------- + + WITH TEXT_IO; + USE TEXT_IO; + + PACKAGE DEFS IS + + ----------------------------------------------------------------------- + -- -- + -- THIS PACKAGE IS USED BY MACROSUB.ADA, PARSEMAC.ADA, AND BY -- + -- GETSUBS.ADA. THE PACKAGE CONTAINS VARIABLE DECLARATIONS WHICH -- + -- NEED TO BE KNOWN BY ALL OF THE PROCEDURES AND PACKAGES WHICH -- + -- MAKE UP THE PROGRAM. -- + -- -- + ----------------------------------------------------------------------- + + MAX_VAL_LENGTH : CONSTANT INTEGER := 400; + + SUBTYPE VAL_STRING IS STRING (1..MAX_VAL_LENGTH); + + TYPE REC_TYPE IS RECORD + MACRO_NAME : STRING (1..80); + NAME_LENGTH, VALUE_LENGTH : INTEGER; + MACRO_VALUE : VAL_STRING; + END RECORD; + + TYPE TABLE_TYPE IS ARRAY (1..100) OF REC_TYPE; + + SYMBOL_TABLE : TABLE_TYPE; + + NUM_MACROS : INTEGER; + + END DEFS; + + WITH TEXT_IO; + USE TEXT_IO; + WITH DEFS; + USE DEFS; + + PACKAGE GETSUBS IS + + ------------------------------------------------------------------------ + -- -- + -- THIS PACKAGE IS USED BY MACROSUB.ADA FOR READING FROM MACRO.DFS -- + -- THE VALUES FOR THE MACRO SUBSTITUTIONS FOR A TEST TAPE. -- + -- -- + ------------------------------------------------------------------------ + + MAC_FILE, LINE_LEN : EXCEPTION; + + PROCEDURE CALC_MAX_VALS(INDEX, LENGTH, MAX_IN_LEN : IN INTEGER; + CALCULATED : OUT BOOLEAN); + + PROCEDURE FILL_TABLE; + + END GETSUBS; + + PACKAGE BODY GETSUBS IS + + ----------------------------------------------------------------------- + -- -- + -- PROCEDURE CALC_MAX_VALS CALCULATES THE VALUE FOR THE MACRO -- + -- READ FROM MACRO.DFS IF ITS LENGTH IS EQUAL OR NEARLY EQUAL TO -- + -- MAX_IN_LEN. IT THEN RETURNS A FLAG SET TO TRUE IF A VALUE WAS -- + -- CALCULATED, FALSE IF ONE WAS NOT. -- + -- -- + ----------------------------------------------------------------------- + + PROCEDURE CALC_MAX_VALS(INDEX, LENGTH, MAX_IN_LEN : IN INTEGER; + CALCULATED : OUT BOOLEAN) IS + + BEGIN + + IF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = "BIG_ID1" + THEN SYMBOL_TABLE (INDEX).MACRO_VALUE (1..MAX_IN_LEN) := + (1..(MAX_IN_LEN-1) => 'A') & "1"; + CALCULATED := TRUE; + ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = + "BIG_ID2" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE + (1..MAX_IN_LEN) := (1..(MAX_IN_LEN-1) => 'A') & "2"; + CALCULATED := TRUE; + ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = + "BIG_ID3" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE + (1..MAX_IN_LEN) := (1..(MAX_IN_LEN + 1)/2 => 'A') & "3" & + ((MAX_IN_LEN + 1)/2 + 2..MAX_IN_LEN => 'A'); + CALCULATED := TRUE; + ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = + "BIG_ID4" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE + (1..MAX_IN_LEN) := (1..(MAX_IN_LEN + 1)/2 => 'A') & "4" & + ((MAX_IN_LEN + 1)/2 + 2..MAX_IN_LEN => 'A'); + CALCULATED := TRUE; + ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = + "BIG_STRING1" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE + (1..(MAX_IN_LEN + 1)/2 + 2) := + '"' & (1..(MAX_IN_LEN + 1)/2 => 'A') & '"'; + CALCULATED := TRUE; + ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = + "BIG_STRING2" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE + (1..MAX_IN_LEN - (MAX_IN_LEN + 1)/2 + 2) := + '"' & (2..MAX_IN_LEN - (MAX_IN_LEN + 1)/2 => 'A') & + '1' & '"'; + CALCULATED := TRUE; + ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = + "MAX_STRING_LITERAL" THEN SYMBOL_TABLE (INDEX). + MACRO_VALUE (1..MAX_IN_LEN) := '"' & + (1..MAX_IN_LEN-2 => 'A') & '"'; + CALCULATED := TRUE; + ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = + "BIG_INT_LIT" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE + (1..MAX_IN_LEN) := (1..MAX_IN_LEN-3 => '0') & "298"; + CALCULATED := TRUE; + ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = + "BIG_REAL_LIT" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE + (1..MAX_IN_LEN) := (1..MAX_IN_LEN-5 => '0') & "690.0"; + CALCULATED := TRUE; + ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = + "MAX_LEN_INT_BASED_LITERAL" THEN + SYMBOL_TABLE (INDEX). + MACRO_VALUE (1..MAX_IN_LEN) := "2:" & + (1..MAX_IN_LEN - 5 => '0') & "11:"; + CALCULATED := TRUE; + ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = + "MAX_LEN_REAL_BASED_LITERAL" THEN SYMBOL_TABLE (INDEX). + MACRO_VALUE (1..MAX_IN_LEN) := "16:" & + (1..MAX_IN_LEN - 7 => '0') & "F.E:"; + CALCULATED := TRUE; + ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = + "BLANKS" THEN SYMBOL_TABLE (INDEX).MACRO_VALUE + (1..MAX_IN_LEN-20) := (1..MAX_IN_LEN-20 => ' '); + CALCULATED := TRUE; + ELSE + CALCULATED := FALSE; + END IF; + IF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = + "BLANKS" THEN SYMBOL_TABLE (INDEX).VALUE_LENGTH := + MAX_IN_LEN - 20; + ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = + "BIG_STRING1" THEN + SYMBOL_TABLE (INDEX).VALUE_LENGTH := + (MAX_IN_LEN + 1)/2 + 2; + ELSIF SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) = + "BIG_STRING2" THEN + SYMBOL_TABLE (INDEX).VALUE_LENGTH := + MAX_IN_LEN - (MAX_IN_LEN + 1)/2 + 2; + ELSE SYMBOL_TABLE (INDEX).VALUE_LENGTH := MAX_IN_LEN; + END IF; + END CALC_MAX_VALS; + + ----------------------------------------------------------------------- + -- -- + -- PROCEDURE FILL_TABLE READS THE MACRO NAMES AND MACRO VALUES IN -- + -- FROM MACRO.DFS AND STORES THEM IN THE SYMBOL TABLE. PROCEDURE -- + -- CALC_MAX_VALS IS CALLED TO DETERMINE IF THE MACRO VALUE SHOULD -- + -- BE CALCULATED OR READ FROM MACRO.DFS. -- + -- -- + ----------------------------------------------------------------------- + + PROCEDURE FILL_TABLE IS + + INFILE1 : FILE_TYPE; + MACRO_FILE : CONSTANT STRING := "MACRO.DFS"; + A_LINE : VAL_STRING; + I, INDEX, LENGTH, HOLD, A_LENGTH, NAME : INTEGER; + MAX_IN_LEN : INTEGER := 1; + CALCULATED : BOOLEAN; + + BEGIN + INDEX := 1; + BEGIN + OPEN (INFILE1, IN_FILE, MACRO_FILE); + EXCEPTION + WHEN NAME_ERROR => + PUT_LINE ("** ERROR: MACRO FILE " & MACRO_FILE & + " NOT FOUND."); + RAISE MAC_FILE; + END; + WHILE NOT END_OF_FILE (INFILE1) LOOP + GET_LINE (INFILE1, A_LINE, A_LENGTH); + IF A_LENGTH > 0 AND A_LINE (1..2) /= "--" AND + A_LINE (1) /= ' ' AND A_LINE (1) /= ASCII.HT THEN + I := 1; + WHILE I <= A_LENGTH AND THEN + ((A_LINE (I) IN 'A'..'Z') OR + (A_LINE (I) IN '0'..'9') OR + A_LINE (I) = '_') LOOP + I := I + 1; + END LOOP; + I := I - 1; + LENGTH := I; + BEGIN + SYMBOL_TABLE (INDEX).MACRO_NAME (1..LENGTH) := + A_LINE (1..I); + EXCEPTION + WHEN CONSTRAINT_ERROR => + PUT_LINE ("** ERROR: LINE LENGTH IS " & + "GREATER THAN MAX_VAL_LENGTH."); + RAISE LINE_LEN; + END; + SYMBOL_TABLE (INDEX).NAME_LENGTH := I; + CALC_MAX_VALS (INDEX, LENGTH, MAX_IN_LEN, + CALCULATED); + IF NOT CALCULATED THEN + I := I + 1; + WHILE A_LINE (I) = ' ' OR A_LINE (I) = + ASCII.HT LOOP + I := I + 1; + IF SYMBOL_TABLE (INDEX).MACRO_NAME + (1..LENGTH) = "BLANKS" THEN + EXIT; + END IF; + END LOOP; + HOLD := I; + + -- MACRO VALUE BEGINS AT POSITION HOLD. + -- NOW FIND WHERE IT ENDS BY STARTING AT THE END OF THE INPUT + -- LINE AND SEARCHING BACKWARD FOR A NON-BLANK. + + I := A_LENGTH; + WHILE I > HOLD AND THEN (A_LINE (I) = ' ' + OR A_LINE(I) = ASCII.HT) LOOP + I := I - 1; + END LOOP; + LENGTH := I - HOLD + 1; + SYMBOL_TABLE (INDEX).MACRO_VALUE (1..LENGTH) + := A_LINE (HOLD..I); + SYMBOL_TABLE (INDEX).VALUE_LENGTH := LENGTH; + NAME := SYMBOL_TABLE (INDEX).NAME_LENGTH; + IF SYMBOL_TABLE (INDEX).MACRO_NAME (1..NAME) = + "MAX_IN_LEN" THEN MAX_IN_LEN := + INTEGER'VALUE (SYMBOL_TABLE (INDEX). + MACRO_VALUE (1..LENGTH)); + END IF; + END IF; + INDEX := INDEX + 1; + END IF; + END LOOP; + NUM_MACROS := INDEX - 1; + CLOSE (INFILE1); + END FILL_TABLE; + + BEGIN + NULL; + END GETSUBS; + + WITH TEXT_IO; + USE TEXT_IO; + WITH DEFS; + USE DEFS; + + PACKAGE PARSEMAC IS + + ------------------------------------------------------------------------ + -- -- + -- THIS PACKAGE IS USED BY MACROSUB.ADA FOR FINDING A MACRO TO -- + -- SUBSTITUTE. MACRO SUBSTITUTIONS ARE MADE IN *.TST TESTS IN THE -- + -- ACVC TEST SUITE. THIS PROCEDURE IS CURRENTLY SET UP FOR ACVC -- + -- VERSION 1.10. -- + -- -- + ------------------------------------------------------------------------ + + PROCEDURE LOOK_FOR_MACRO (A_LINE : IN STRING; + A_LENGTH : IN INTEGER; + PTR : IN OUT INTEGER; + MACRO : OUT STRING; + MACRO_LEN : IN OUT INTEGER); + + + PROCEDURE WHICH_MACRO (MACRO : IN STRING; + MACRO_LEN : IN INTEGER; + TEMP_MACRO : OUT STRING; + TEMP_MACRO_LEN : IN OUT INTEGER); + + END PARSEMAC; + + PACKAGE BODY PARSEMAC IS + + ----------------------------------------------------------------------- + -- PROCEDURE LOOK_FOR_MACRO LOOKS FOR A DOLLAR SIGN WHICH SIGNALS -- + -- THE START OF A MACRO IN THE *.TST FILES. IT THEN COUNTS -- + -- CHARACTERS UNTIL A , , OR <_> IS NOT FOUND. -- + -- RETURN PARAMETERS SEND THE BEGINNING POINTER AND LENGTH OF THE -- + -- MACRO BACK TO THE MAIN PROGRAM. ALSO RETURNED IS THE MACRO -- + -- STRING. -- + ----------------------------------------------------------------------- + + PROCEDURE LOOK_FOR_MACRO (A_LINE : IN STRING; + A_LENGTH : IN INTEGER; + PTR : IN OUT INTEGER; + MACRO : OUT STRING; + MACRO_LEN : IN OUT INTEGER) IS + + II, J : INTEGER := INTEGER'LAST; + + BEGIN + FOR I IN PTR..A_LENGTH LOOP + IF A_LINE (I) = '$' THEN + II := I+1; + EXIT; + END IF; + II := I; + END LOOP; + IF II < A_LENGTH THEN -- DOLLAR SIGN IS FOUND. + J := II; + WHILE J <= A_LENGTH AND THEN ((A_LINE(J) IN 'A'..'Z') OR + (A_LINE(J) IN '0'..'9') OR + A_LINE(J) = '_') LOOP + J := J+1; + END LOOP; + J := J-1; + MACRO_LEN := (J-II+1); + MACRO (1..MACRO_LEN) := A_LINE (II .. J); + -- DON'T INCLUDE THE DOLLAR SIGN + PTR := J+1; + ELSE + MACRO_LEN := 0; + END IF; + RETURN; + END LOOK_FOR_MACRO; + + ------------------------------------------------------------------------ + -- PROCEDURE WHICH_MACRO COMPARES THE INPUT MACRO STRING TO A -- + -- VALUE READ FROM MACRO.DFS AND STORED IN THE SYMBOL TABLE AND -- + -- RETURNS THE MACRO SUBSTITUTION STRING BACK TO THE MAIN PROGRAM. -- + ------------------------------------------------------------------------ + + PROCEDURE WHICH_MACRO (MACRO : IN STRING; + MACRO_LEN : IN INTEGER; + TEMP_MACRO : OUT STRING; + TEMP_MACRO_LEN : IN OUT INTEGER) IS + + BEGIN + FOR INDEX IN 1 .. NUM_MACROS LOOP + IF MACRO (1..MACRO_LEN) = + SYMBOL_TABLE (INDEX).MACRO_NAME + (1..SYMBOL_TABLE (INDEX).NAME_LENGTH) THEN + TEMP_MACRO_LEN := + SYMBOL_TABLE (INDEX).VALUE_LENGTH; + TEMP_MACRO (1..TEMP_MACRO_LEN) := + SYMBOL_TABLE (INDEX).MACRO_VALUE + (1..TEMP_MACRO_LEN); + EXIT; + END IF; + IF INDEX = NUM_MACROS THEN + PUT_LINE ("** ERROR: MACRO " & MACRO (1..MACRO_LEN) + & " NOT FOUND. UPDATE PROGRAM."); + TEMP_MACRO_LEN := MACRO_LEN; + TEMP_MACRO (1..TEMP_MACRO_LEN) := + MACRO (1..MACRO_LEN); + END IF; + END LOOP; + + END WHICH_MACRO; + + BEGIN + NULL; + END PARSEMAC; + + WITH TEXT_IO, GETSUBS, PARSEMAC, DEFS; + USE TEXT_IO, GETSUBS, PARSEMAC, DEFS; + + PROCEDURE MACROSUB IS + + ------------------------------------------------------------------------ + -- -- + -- MACROSUB IS THE MAIN PROGRAM THAT CALLS PROCEDURES IN TWO -- + -- PACKAGES, GETSUBS AND PARSEMAC. THIS PROGRAM IS USED TO MAKE -- + -- THE MACRO SUBSTITUTIONS FOR TST TESTS IN THE ACVC TEST SUITE. -- + -- -- + ------------------------------------------------------------------------ + + INFILE1, INFILE2, OUTFILE1 : FILE_TYPE; + FNAME, MACRO : VAL_STRING; + LENGTH, A_LENGTH, PTR, + TEMP_MACRO_LENGTH, MACRO_LEN, FILE_COUNT : INTEGER := 0; + A_LINE, TEMP_MACRO, TEMP_LINE, NEW_LINE : VAL_STRING; + END_OF_LINE_SEARCH, FLAG : BOOLEAN := FALSE; + TESTS_FILE : CONSTANT STRING := "TSTTESTS.DAT"; + TSTTESTS,FILE_CRE : EXCEPTION; + + BEGIN + PUT_LINE ("BEGINNING MACRO SUBSTITUTIONS."); + FILL_TABLE; + BEGIN + OPEN (INFILE2, IN_FILE, TESTS_FILE); + EXCEPTION + WHEN NAME_ERROR => + PUT_LINE ("** ERROR: ERROR DURING OPENING OF " & + "TSTTESTS.DAT"); + RAISE TSTTESTS; + END; + WHILE NOT END_OF_FILE (INFILE2) LOOP + GET_LINE (INFILE2, FNAME, LENGTH); + FILE_COUNT := FILE_COUNT + 1; + BEGIN + OPEN (INFILE1, IN_FILE, FNAME(1..LENGTH)); + EXCEPTION + WHEN NAME_ERROR => + PUT_LINE ("** ERROR: ERROR DURING OPENING OF " & + FNAME(1..LENGTH) & "."); + FLAG := TRUE; + END; + IF NOT FLAG THEN + PUT_LINE ("WORKING ON " & FNAME(1..LENGTH)); + IF FILE_COUNT = 70 THEN + PUT_LINE ("MACRO SUBSTITUTIONS HALF COMPLETED."); + END IF; + FOR I IN REVERSE 1 .. LENGTH LOOP + IF FNAME(I) = ';' THEN + LENGTH := I - 1; + EXIT; + END IF; + END LOOP; + IF FNAME (LENGTH-2..LENGTH) = "TST" THEN + FNAME (LENGTH-2..LENGTH) := "ADT"; + ELSIF FNAME (LENGTH-2..LENGTH) = "tst" THEN + FNAME (LENGTH-2..LENGTH) := "adt"; + END IF; + BEGIN + CREATE (OUTFILE1, OUT_FILE, FNAME (1..LENGTH)); + EXCEPTION + WHEN OTHERS => + PUT_LINE ("** ERROR: EXCEPTION RAISED DURING" & + " ATTEMPTED CREATION OF " & + FNAME(1..LENGTH) & "."); + RAISE FILE_CRE; + END; + WHILE NOT END_OF_FILE (INFILE1) LOOP + GET_LINE (INFILE1, A_LINE, A_LENGTH); + IF A_LENGTH > 0 AND A_LINE(1..2) /= "--" THEN + END_OF_LINE_SEARCH := FALSE; + PTR := 1; + WHILE NOT END_OF_LINE_SEARCH LOOP + LOOK_FOR_MACRO (A_LINE, A_LENGTH, PTR, + MACRO, MACRO_LEN); + IF MACRO_LEN = 0 THEN + END_OF_LINE_SEARCH := TRUE; + ELSE -- SEE WHICH MACRO IT IS + WHICH_MACRO (MACRO, MACRO_LEN, + TEMP_MACRO, TEMP_MACRO_LENGTH); + END IF; + IF NOT END_OF_LINE_SEARCH THEN + IF PTR-MACRO_LEN-2 > 0 THEN + -- IF MACRO IS NOT FIRST ON THE LINE + NEW_LINE (1..PTR-MACRO_LEN-2) + := A_LINE(1..PTR-MACRO_LEN -2); + -- THE OLD LINE UNTIL THE DOLLAR SIGN + END IF; + NEW_LINE(PTR-MACRO_LEN-1 .. + TEMP_MACRO_LENGTH + + (PTR-MACRO_LEN) - 2) := + TEMP_MACRO(1..TEMP_MACRO_LENGTH); + IF PTR <= A_LENGTH THEN + -- IF MACRO IS NOT LAST ON THE LINE + NEW_LINE (TEMP_MACRO_LENGTH + + PTR-MACRO_LEN - 1 .. + TEMP_MACRO_LENGTH - 1 + + A_LENGTH - MACRO_LEN) := + A_LINE (PTR..A_LENGTH); + ELSE + END_OF_LINE_SEARCH := TRUE; + END IF; + A_LENGTH := A_LENGTH + + TEMP_MACRO_LENGTH - + MACRO_LEN - 1; + A_LINE (1..A_LENGTH) := + NEW_LINE (1..A_LENGTH); + PTR := PTR - MACRO_LEN + + TEMP_MACRO_LENGTH - 1; + END IF; + END LOOP; + END IF; + PUT_LINE (OUTFILE1, A_LINE (1..A_LENGTH)); + END LOOP; + CLOSE (OUTFILE1); + CLOSE (INFILE1); + ELSE + FLAG := FALSE; + END IF; + END LOOP; + CLOSE (INFILE2); + PUT_LINE ("MACRO SUBSTITUTIONS COMPLETED."); + EXCEPTION + WHEN MAC_FILE | LINE_LEN | TSTTESTS | FILE_CRE => + NULL; + WHEN OTHERS => + PUT_LINE ("UNEXPECTED EXCEPTION RAISED"); + END MACROSUB; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/repbody.ada gcc-3.4.0/gcc/testsuite/ada/acats/support/repbody.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/support/repbody.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/repbody.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,329 ---- + -- REPBODY.ADA + -- + -- 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. + --* + -- + -- HISTORY: + -- DCB 04/27/80 + -- JRK 6/10/80 + -- JRK 11/12/80 + -- JRK 8/6/81 + -- JRK 10/27/82 + -- JRK 6/1/84 + -- JRK 11/18/85 ADDED PRAGMA ELABORATE. + -- PWB 07/29/87 ADDED STATUS ACTION_REQUIRED AND + -- PROCEDURE SPECIAL_ACTION. + -- TBN 08/20/87 ADDED FUNCTION LEGAL_FILE_NAME. + -- BCB 05/17/90 MODIFIED TO ALLOW OUTPUT TO DIRECT_IO FILE. + -- ADDED TIME-STAMP. + -- LDC 05/17/90 REMOVED OUTPUT TO DIRECT_IO FILE. + -- WMC 08/11/92 UPDATED ACVC VERSION STRING TO "9X BASIC". + -- DTN 07/05/92 UPDATED ACVC VERSION STRING TO + -- "ACVC 2.0 JULY 6 1993 DRAFT". + -- WMC 01/24/94 MODIFIED LEGAL_FILE_NAME TO ALLOW FIVE POSSIBLE + -- FILE NAMES (INCREASED RANGE OF TYPE FILE_NUM TO 1..5). + -- WMC 11/06/94 UPDATED ACVC VERSION STRING TO + -- "ACVC 2.0 NOVEMBER 6 1994 DRAFT". + -- DTN 12/04/94 UPDATED ACVC VERSION STRING TO + -- "ACVC 2.0". + -- KAS 06/19/95 ADDED FUNCTION IDENT_WIDE_CHAR. + -- KAS 06/19/95 ADDED FUNCTION IDENT_WIDE_STR. + -- DTN 11/21/95 UPDATED ACVC VERSION STRING TO + -- "ACVC 2.0.1". + -- DTN 12/14/95 UPDATED ACVC VERSION STRING TO + -- "ACVC 2.1". + -- EDS 12/17/97 UPDATED ACVC VERSION STRING TO + -- "2.2". + -- RLB 3/16/00 UPDATED ACATS VERSION STRING TO "2.3". + -- CHANGED VARIOUS STRINGS TO READ "ACATS". + -- RLB 3/22/01 UPDATED ACATS VERSION STRING TO "2.4". + -- RLB 3/29/01 UPDATED ACATS VERSION STRING TO "2.5". + + WITH TEXT_IO, CALENDAR; + USE TEXT_IO, CALENDAR; + PRAGMA ELABORATE (TEXT_IO, CALENDAR); + + PACKAGE BODY REPORT IS + + TYPE STATUS IS (PASS, FAIL, DOES_NOT_APPLY, ACTION_REQUIRED, + UNKNOWN); + + TYPE TIME_INTEGER IS RANGE 0 .. 86_400; + + TEST_STATUS : STATUS := FAIL; + + MAX_NAME_LEN : CONSTANT := 15; -- MAXIMUM TEST NAME LENGTH. + TEST_NAME : STRING (1..MAX_NAME_LEN); + + NO_NAME : CONSTANT STRING (1..7) := "NO_NAME"; + TEST_NAME_LEN : INTEGER RANGE 0..MAX_NAME_LEN := 0; + + + + ACATS_VERSION : CONSTANT STRING := "2.5"; + -- VERSION OF ACATS BEING RUN (X.XX). + + PROCEDURE PUT_MSG (MSG : STRING) IS + -- WRITE MESSAGE. LONG MESSAGES ARE FOLDED (AND INDENTED). + MAX_LEN : CONSTANT INTEGER RANGE 50..150 := 72; -- MAXIMUM + -- OUTPUT LINE LENGTH. + INDENT : CONSTANT INTEGER := TEST_NAME_LEN + 9; -- AMOUNT TO + -- INDENT CONTINUATION LINES. + I : INTEGER := 0; -- CURRENT INDENTATION. + M : INTEGER := MSG'FIRST; -- START OF MESSAGE SLICE. + N : INTEGER; -- END OF MESSAGE SLICE. + BEGIN + LOOP + IF I + (MSG'LAST-M+1) > MAX_LEN THEN + N := M + (MAX_LEN-I) - 1; + IF MSG (N) /= ' ' THEN + WHILE N >= M AND THEN MSG (N+1) /= ' ' LOOP + N := N - 1; + END LOOP; + IF N < M THEN + N := M + (MAX_LEN-I) - 1; + END IF; + END IF; + ELSE N := MSG'LAST; + END IF; + SET_COL (STANDARD_OUTPUT, TEXT_IO.COUNT (I+1)); + PUT_LINE (STANDARD_OUTPUT, MSG (M..N)); + I := INDENT; + M := N + 1; + WHILE M <= MSG'LAST AND THEN MSG (M) = ' ' LOOP + M := M + 1; + END LOOP; + EXIT WHEN M > MSG'LAST; + END LOOP; + END PUT_MSG; + + FUNCTION TIME_STAMP RETURN STRING IS + TIME_NOW : CALENDAR.TIME; + YEAR, + MONTH, + DAY, + HOUR, + MINUTE, + SECOND : TIME_INTEGER := 1; + + FUNCTION CONVERT (NUMBER : TIME_INTEGER) RETURN STRING IS + STR : STRING (1..2) := (OTHERS => '0'); + DEC_DIGIT : CONSTANT STRING := "0123456789"; + NUM : TIME_INTEGER := NUMBER; + BEGIN + IF NUM = 0 THEN + RETURN STR; + ELSE + NUM := NUM MOD 100; + STR (2) := DEC_DIGIT (INTEGER (NUM MOD 10 + 1)); + NUM := NUM / 10; + STR (1) := DEC_DIGIT (INTEGER (NUM + 1)); + RETURN STR; + END IF; + END CONVERT; + BEGIN + TIME_NOW := CALENDAR.CLOCK; + SPLIT (TIME_NOW, YEAR_NUMBER (YEAR), MONTH_NUMBER (MONTH), + DAY_NUMBER (DAY), DAY_DURATION (SECOND)); + HOUR := SECOND / 3600; + SECOND := SECOND MOD 3600; + MINUTE := SECOND / 60; + SECOND := SECOND MOD 60; + RETURN (CONVERT (TIME_INTEGER (YEAR)) & "-" & + CONVERT (TIME_INTEGER (MONTH)) & "-" & + CONVERT (TIME_INTEGER (DAY)) & " " & + CONVERT (TIME_INTEGER (HOUR)) & ":" & + CONVERT (TIME_INTEGER (MINUTE)) & ":" & + CONVERT (TIME_INTEGER (SECOND))); + END TIME_STAMP; + + PROCEDURE TEST (NAME : STRING; DESCR : STRING) IS + BEGIN + TEST_STATUS := PASS; + IF NAME'LENGTH <= MAX_NAME_LEN THEN + TEST_NAME_LEN := NAME'LENGTH; + ELSE TEST_NAME_LEN := MAX_NAME_LEN; + END IF; + TEST_NAME (1..TEST_NAME_LEN) := + NAME (NAME'FIRST .. NAME'FIRST+TEST_NAME_LEN-1); + + PUT_MSG (""); + PUT_MSG (",.,. " & TEST_NAME (1..TEST_NAME_LEN) & " " & + "ACATS " & ACATS_VERSION & " " & TIME_STAMP); + PUT_MSG ("---- " & TEST_NAME (1..TEST_NAME_LEN) & " " & + DESCR & "."); + END TEST; + + PROCEDURE COMMENT (DESCR : STRING) IS + BEGIN + PUT_MSG (" - " & TEST_NAME (1..TEST_NAME_LEN) & " " & + DESCR & "."); + END COMMENT; + + PROCEDURE FAILED (DESCR : STRING) IS + BEGIN + TEST_STATUS := FAIL; + PUT_MSG (" * " & TEST_NAME (1..TEST_NAME_LEN) & " " & + DESCR & "."); + END FAILED; + + PROCEDURE NOT_APPLICABLE (DESCR : STRING) IS + BEGIN + IF TEST_STATUS = PASS OR TEST_STATUS = ACTION_REQUIRED THEN + TEST_STATUS := DOES_NOT_APPLY; + END IF; + PUT_MSG (" + " & TEST_NAME (1..TEST_NAME_LEN) & " " & + DESCR & "."); + END NOT_APPLICABLE; + + PROCEDURE SPECIAL_ACTION (DESCR : STRING) IS + BEGIN + IF TEST_STATUS = PASS THEN + TEST_STATUS := ACTION_REQUIRED; + END IF; + PUT_MSG (" ! " & TEST_NAME (1..TEST_NAME_LEN) & " " & + DESCR & "."); + END SPECIAL_ACTION; + + PROCEDURE RESULT IS + BEGIN + CASE TEST_STATUS IS + WHEN PASS => + PUT_MSG ("==== " & TEST_NAME (1..TEST_NAME_LEN) & + " PASSED ============================."); + WHEN DOES_NOT_APPLY => + PUT_MSG ("++++ " & TEST_NAME (1..TEST_NAME_LEN) & + " NOT-APPLICABLE ++++++++++++++++++++."); + WHEN ACTION_REQUIRED => + PUT_MSG ("!!!! " & TEST_NAME (1..TEST_NAME_LEN) & + " TENTATIVELY PASSED !!!!!!!!!!!!!!!!."); + PUT_MSG ("!!!! " & (1..TEST_NAME_LEN => ' ') & + " SEE '!' COMMENTS FOR SPECIAL NOTES!!"); + WHEN OTHERS => + PUT_MSG ("**** " & TEST_NAME (1..TEST_NAME_LEN) & + " FAILED ****************************."); + END CASE; + TEST_STATUS := FAIL; + TEST_NAME_LEN := NO_NAME'LENGTH; + TEST_NAME (1..TEST_NAME_LEN) := NO_NAME; + END RESULT; + + FUNCTION IDENT_INT (X : INTEGER) RETURN INTEGER IS + BEGIN + IF EQUAL (X, X) THEN -- ALWAYS EQUAL. + RETURN X; -- ALWAYS EXECUTED. + END IF; + RETURN 0; -- NEVER EXECUTED. + END IDENT_INT; + + FUNCTION IDENT_CHAR (X : CHARACTER) RETURN CHARACTER IS + BEGIN + IF EQUAL (CHARACTER'POS(X), CHARACTER'POS(X)) THEN -- ALWAYS + -- EQUAL. + RETURN X; -- ALWAYS EXECUTED. + END IF; + RETURN '0'; -- NEVER EXECUTED. + END IDENT_CHAR; + + FUNCTION IDENT_WIDE_CHAR (X : WIDE_CHARACTER) RETURN WIDE_CHARACTER IS + BEGIN + IF EQUAL (WIDE_CHARACTER'POS(X), WIDE_CHARACTER'POS(X)) THEN + -- ALWAYS EQUAL. + RETURN X; -- ALWAYS EXECUTED. + END IF; + RETURN '0'; -- NEVER EXECUTED. + END IDENT_WIDE_CHAR; + + FUNCTION IDENT_BOOL (X : BOOLEAN) RETURN BOOLEAN IS + BEGIN + IF EQUAL (BOOLEAN'POS(X), BOOLEAN'POS(X)) THEN -- ALWAYS + -- EQUAL. + RETURN X; -- ALWAYS EXECUTED. + END IF; + RETURN FALSE; -- NEVER EXECUTED. + END IDENT_BOOL; + + FUNCTION IDENT_STR (X : STRING) RETURN STRING IS + BEGIN + IF EQUAL (X'LENGTH, X'LENGTH) THEN -- ALWAYS EQUAL. + RETURN X; -- ALWAYS EXECUTED. + END IF; + RETURN ""; -- NEVER EXECUTED. + END IDENT_STR; + + FUNCTION IDENT_WIDE_STR (X : WIDE_STRING) RETURN WIDE_STRING IS + BEGIN + IF EQUAL (X'LENGTH, X'LENGTH) THEN -- ALWAYS EQUAL. + RETURN X; -- ALWAYS EXECUTED. + END IF; + RETURN ""; -- NEVER EXECUTED. + END IDENT_WIDE_STR; + + FUNCTION EQUAL (X, Y : INTEGER) RETURN BOOLEAN IS + REC_LIMIT : CONSTANT INTEGER RANGE 1..100 := 3; -- RECURSION + -- LIMIT. + Z : BOOLEAN; -- RESULT. + BEGIN + IF X < 0 THEN + IF Y < 0 THEN + Z := EQUAL (-X, -Y); + ELSE Z := FALSE; + END IF; + ELSIF X > REC_LIMIT THEN + Z := EQUAL (REC_LIMIT, Y-X+REC_LIMIT); + ELSIF X > 0 THEN + Z := EQUAL (X-1, Y-1); + ELSE Z := Y = 0; + END IF; + RETURN Z; + EXCEPTION + WHEN OTHERS => + RETURN X = Y; + END EQUAL; + + FUNCTION LEGAL_FILE_NAME (X : FILE_NUM := 1; + NAM : STRING := "") + RETURN STRING IS + SUFFIX : STRING (2..6); + BEGIN + IF NAM = "" THEN + SUFFIX := TEST_NAME(3..7); + ELSE + SUFFIX := NAM(3..7); + END IF; + + CASE X IS + WHEN 1 => RETURN ('X' & SUFFIX); + WHEN 2 => RETURN ('Y' & SUFFIX); + WHEN 3 => RETURN ('Z' & SUFFIX); + WHEN 4 => RETURN ('V' & SUFFIX); + WHEN 5 => RETURN ('W' & SUFFIX); + END CASE; + END LEGAL_FILE_NAME; + + BEGIN + + TEST_NAME_LEN := NO_NAME'LENGTH; + TEST_NAME (1..TEST_NAME_LEN) := NO_NAME; + + END REPORT; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/repspec.ada gcc-3.4.0/gcc/testsuite/ada/acats/support/repspec.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/support/repspec.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/repspec.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,149 ---- + -- REPSPEC.ADA + -- + -- 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. + --* + -- + -- PURPOSE: + -- THIS REPORT PACKAGE PROVIDES THE MECHANISM FOR REPORTING THE + -- PASS/FAIL/NOT-APPLICABLE RESULTS OF EXECUTABLE (CLASSES A, C, + -- D, E, AND L) TESTS. + + -- IT ALSO PROVIDES THE MECHANISM FOR GUARANTEEING THAT CERTAIN + -- VALUES BECOME DYNAMIC (NOT KNOWN AT COMPILE-TIME). + + -- HISTORY: + -- JRK 12/13/79 + -- JRK 06/10/80 + -- JRK 08/06/81 + -- JRK 10/27/82 + -- JRK 06/01/84 + -- PWB 07/30/87 ADDED PROCEDURE SPECIAL_ACTION. + -- TBN 08/20/87 ADDED FUNCTION LEGAL_FILE_NAME. + -- BCB 05/17/90 ADDED FUNCTION TIME_STAMP. + -- WMC 01/24/94 INCREASED RANGE OF TYPE FILE_NUM FROM 1..3 TO 1..5. + -- KAS 06/19/95 ADDED FUNCTION IDENT_WIDE_CHAR. + -- KAS 06/19/95 ADDED FUNCTION IDENT_WIDE_STR. + + PACKAGE REPORT IS + + SUBTYPE FILE_NUM IS INTEGER RANGE 1..5; + + -- THE REPORT ROUTINES. + + PROCEDURE TEST -- THIS ROUTINE MUST BE INVOKED AT THE + -- START OF A TEST, BEFORE ANY OF THE + -- OTHER REPORT ROUTINES ARE INVOKED. + -- IT SAVES THE TEST NAME AND OUTPUTS THE + -- NAME AND DESCRIPTION. + ( NAME : STRING; -- TEST NAME, E.G., "C23001A-AB". + DESCR : STRING -- BRIEF DESCRIPTION OF TEST, E.G., + -- "UPPER/LOWER CASE EQUIVALENCE IN " & + -- "IDENTIFIERS". + ); + + PROCEDURE FAILED -- OUTPUT A FAILURE MESSAGE. SHOULD BE + -- INVOKED SEPARATELY TO REPORT THE + -- FAILURE OF EACH SUBTEST WITHIN A TEST. + ( DESCR : STRING -- BRIEF DESCRIPTION OF WHAT FAILED. + -- SHOULD BE PHRASED AS: + -- "(FAILED BECAUSE) ...REASON...". + ); + + PROCEDURE NOT_APPLICABLE -- OUTPUT A NOT-APPLICABLE MESSAGE. + -- SHOULD BE INVOKED SEPARATELY TO REPORT + -- THE NON-APPLICABILITY OF EACH SUBTEST + -- WITHIN A TEST. + ( DESCR : STRING -- BRIEF DESCRIPTION OF WHAT IS + -- NOT-APPLICABLE. SHOULD BE PHRASED AS: + -- "(NOT-APPLICABLE BECAUSE)...REASON...". + ); + + PROCEDURE SPECIAL_ACTION -- OUTPUT A MESSAGE DESCRIBING SPECIAL + -- ACTIONS TO BE TAKEN. + -- SHOULD BE INVOKED SEPARATELY TO GIVE + -- EACH SPECIAL ACTION. + ( DESCR : STRING -- BRIEF DESCRIPTION OF ACTION TO BE + -- TAKEN. + ); + + PROCEDURE COMMENT -- OUTPUT A COMMENT MESSAGE. + ( DESCR : STRING -- THE MESSAGE. + ); + + PROCEDURE RESULT; -- THIS ROUTINE MUST BE INVOKED AT THE + -- END OF A TEST. IT OUTPUTS A MESSAGE + -- INDICATING WHETHER THE TEST AS A + -- WHOLE HAS PASSED, FAILED, IS + -- NOT-APPLICABLE, OR HAS TENTATIVELY + -- PASSED PENDING SPECIAL ACTIONS. + + -- THE DYNAMIC VALUE ROUTINES. + + -- EVEN WITH STATIC ARGUMENTS, THESE FUNCTIONS WILL HAVE DYNAMIC + -- RESULTS. + + FUNCTION IDENT_INT -- AN IDENTITY FUNCTION FOR TYPE INTEGER. + ( X : INTEGER -- THE ARGUMENT. + ) RETURN INTEGER; -- X. + + FUNCTION IDENT_CHAR -- AN IDENTITY FUNCTION FOR TYPE + -- CHARACTER. + ( X : CHARACTER -- THE ARGUMENT. + ) RETURN CHARACTER; -- X. + + FUNCTION IDENT_WIDE_CHAR -- AN IDENTITY FUNCTION FOR TYPE + -- WIDE_CHARACTER. + ( X : WIDE_CHARACTER -- THE ARGUMENT. + ) RETURN WIDE_CHARACTER; -- X. + + FUNCTION IDENT_BOOL -- AN IDENTITY FUNCTION FOR TYPE BOOLEAN. + ( X : BOOLEAN -- THE ARGUMENT. + ) RETURN BOOLEAN; -- X. + + FUNCTION IDENT_STR -- AN IDENTITY FUNCTION FOR TYPE STRING. + ( X : STRING -- THE ARGUMENT. + ) RETURN STRING; -- X. + + FUNCTION IDENT_WIDE_STR -- AN IDENTITY FUNCTION FOR TYPE WIDE_STRING. + ( X : WIDE_STRING -- THE ARGUMENT. + ) RETURN WIDE_STRING; -- X. + + FUNCTION EQUAL -- A RECURSIVE EQUALITY FUNCTION FOR TYPE + -- INTEGER. + ( X, Y : INTEGER -- THE ARGUMENTS. + ) RETURN BOOLEAN; -- X = Y. + + -- OTHER UTILITY ROUTINES. + + FUNCTION LEGAL_FILE_NAME -- A FUNCTION TO GENERATE LEGAL EXTERNAL + -- FILE NAMES. + ( X : FILE_NUM := 1; -- DETERMINES FIRST CHARACTER OF NAME. + NAM : STRING := "" -- DETERMINES REST OF NAME. + ) RETURN STRING; -- THE GENERATED NAME. + + FUNCTION TIME_STAMP -- A FUNCTION TO GENERATE THE TIME AND + -- DATE TO PLACE IN THE OUTPUT OF AN ACVC + -- TEST. + RETURN STRING; -- THE TIME AND DATE. + + END REPORT; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/spprt13s.tst gcc-3.4.0/gcc/testsuite/ada/acats/support/spprt13s.tst *** gcc-3.3.3/gcc/testsuite/ada/acats/support/spprt13s.tst 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/spprt13s.tst 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,67 ---- + -- SPPRT13SP.TST + -- + -- 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. + --* + -- + -- SPECIFICATION FOR PACKAGE SPPRT13 + + -- PURPOSE: + -- THIS PACKAGE CONTAINS CONSTANTS OF TYPE SYSTEM.ADDRESS. + -- THESE CONSTANTS ARE USED BY SELECTED CHAPTER 13 TESTS, + -- BY PARTS OF THE AVAT SYSTEM, AND BY ISOLATED TESTS FOR + -- OTHER CHAPTERS. + + -- MACRO SUBSTITUTIONS: + -- $VARIABLE_ADDRESS, $VARIABLE_ADDRESS1, AND $VARIABLE_ADDRESS2 ARE + -- EXPRESSIONS YIELDING LEGAL ADDRESSES FOR VARIABLES FOR THIS + -- IMPLEMENTATION. + + -- $ENTRY_ADDRESS, $ENTRY_ADDRESS1, AND $ENTRY_ADDRESS2 ARE + -- EXPRESSIONS YIELDING LEGAL ADDRESSES FOR TASK ENTRIES + -- (I.E., FOR INTERRUPTS) FOR THIS IMPLEMENTATION. + + -- IF NO EXPRESSIONS CAN BE GIVEN THAT ARE SATISFACTORY FOR THE + -- VALUES OF THESE CONSTANTS, THEN DECLARE SUITABLE FUNCTIONS + -- IN THE SPECIFICATION OF PACKAGE FCNDECL, CREATE A PACKAGE BODY + -- CONTAINING BODIES FOR THE FUNCTIONS, AND REPLACE THE MACROS WITH + -- APPROPRIATE FUNCTION CALLS. + + WITH FCNDECL; USE FCNDECL; + WITH SYSTEM; + PACKAGE SPPRT13 IS + + VARIABLE_ADDRESS : CONSTANT SYSTEM.ADDRESS := + $VARIABLE_ADDRESS; + VARIABLE_ADDRESS1 : CONSTANT SYSTEM.ADDRESS := + $VARIABLE_ADDRESS1; + VARIABLE_ADDRESS2 : CONSTANT SYSTEM.ADDRESS := + $VARIABLE_ADDRESS2; + + ENTRY_ADDRESS : CONSTANT SYSTEM.ADDRESS := + $ENTRY_ADDRESS; + ENTRY_ADDRESS1 : CONSTANT SYSTEM.ADDRESS := + $ENTRY_ADDRESS1; + ENTRY_ADDRESS2 : CONSTANT SYSTEM.ADDRESS := + $ENTRY_ADDRESS2; + + END SPPRT13; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/tctouch.ada gcc-3.4.0/gcc/testsuite/ada/acats/support/tctouch.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/support/tctouch.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/tctouch.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,264 ---- + -- TCTouch.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. + --* + -- + -- FOUNDATION DESCRIPTION: + -- The tools in this foundation are not peculiar to any particular + -- aspect of the language, but simplify the test writing and reading + -- process. Assert and Assert_Not are used to reduce the textual + -- overhead of the test-that-this-condition-is-(not)-true paradigm. + -- Touch and Validate are used to simplify tracing an expected path + -- of execution. + -- A tag comment of the form: + -- + -- TCTouch.Touch( 'A' ); ----------------------------------------- A + -- + -- is recommended to improve readability of this feature. + -- + -- Report.Test must be called before any of the procedures in this + -- package with the exception of Touch. + -- The usage paradigm is to call Touch in locations in the test where you + -- want a trace of execution. Each call to Touch should have a unique + -- character associated with it. At each place where a check can + -- reasonably be performed to determine correct execution of a + -- sub-test, a call to Validate should be made. The first parameter + -- passed to Validate is the expected string of characters produced by + -- call(s) to Touch in the subtest just executed. The second parameter + -- is the message to pass to Report.Failed if the expected sequence was + -- not executed. + -- + -- Validate should always be called after calls to Touch before a test + -- completes. + -- + -- In the event that calls may have been made to Touch that are not + -- intended to be recorded, or, the failure of a previous subtest may + -- leave Touch calls "Unvalidated", the procedure Flush will reset the + -- tracker to the "empty" state. Flush does not make any calls to + -- Report. + -- + -- Calls to Assert and Assert_Not are to replace the idiom: + -- + -- if BadCondition then -- or if not PositiveTest then + -- Report.Failed(Message); + -- end if; + -- + -- with: + -- + -- Assert_Not( BadCondition, Message ); -- or + -- Assert( PositiveTest, Message ); + -- + -- Implementation_Check is for use with tests that cross the boundary + -- between the core and the Special Needs Annexes. There are several + -- instances where language in the core becomes enforceable only when + -- a Special Needs Annex is supported. Implementation_Check should be + -- called in place of Report.Failed in these cases; it examines the + -- constants in Impdef that indicate if the particular Special Needs + -- Annex is being validated with this validation; and acts accordingly. + -- + -- The constant Foundation_ID contains the internal change version + -- for this software. + -- + -- ERROR CONDITIONS: + -- + -- It is an error to perform more than Max_Touch_Count (80) calls to + -- Touch without a subsequent call to Validate. To do so will cause + -- a false test failure. + -- + -- CHANGE HISTORY: + -- 02 JUN 94 SAIC Initial version + -- 27 OCT 94 SAIC Revised version + -- 07 AUG 95 SAIC Added Implementation_Check + -- 07 FEB 96 SAIC Changed to match new Impdef for 2.1 + -- 16 MAR 00 RLB Changed foundation id to reflect test suite version. + -- 22 MAR 01 RLB Changed foundation id to reflect test suite version. + -- 29 MAR 02 RLB Changed foundation id to reflect test suite version. + -- + --! + + package TCTouch is + Foundation_ID : constant String := "TCTouch ACATS 2.5"; + Max_Touch_Count : constant := 80; + + procedure Assert ( SB_True : Boolean; Message : String ); + procedure Assert_Not( SB_False : Boolean; Message : String ); + + procedure Touch ( A_Tag : Character ); + procedure Validate( Expected: String; + Message : String; + Order_Meaningful : Boolean := True ); + + procedure Flush; + + type Special_Needs_Annexes is ( Annex_C, Annex_D, Annex_E, + Annex_F, Annex_G, Annex_H ); + + procedure Implementation_Check( Message : in String; + Annex : in Special_Needs_Annexes + := Annex_C ); + -- If Impdef.Validating_Annex_ is true, will call Report.Failed + -- otherwise will call Report.Not_Applicable. This is to allow tests + -- which are driven by wording in the core of the language, yet have + -- their functionality dictated by the Special Needs Annexes to perform + -- dual purpose. + -- The default of Annex_C for the Annex parameter is to support early + -- tests written with the assumption that Implementation_Check was + -- expressly for use with the Systems Programming Annex. + + end TCTouch; + + with Report; + with Impdef; + package body TCTouch is + + procedure Assert( SB_True : Boolean; Message : String ) is + begin + if not SB_True then + Report.Failed( "Assertion failed: " & Message ); + end if; + end Assert; + + procedure Assert_Not( SB_False : Boolean; Message : String ) is + begin + if SB_False then + Report.Failed( "Assertion failed: " & Message ); + end if; + end Assert_Not; + + Collection : String(1..Max_Touch_Count); + Finger : Natural := 0; + + procedure Touch ( A_Tag : Character ) is + begin + Finger := Finger+1; + Collection(Finger) := A_Tag; + exception + when Constraint_Error => + Report.Failed("Trace Overflow: " & Collection); + Finger := 0; + end Touch; + + procedure Sort_String( S: in out String ) is + -- algorithm from Booch Components Page 472 + No_Swaps : Boolean; + procedure Swap(C1, C2: in out Character) is + T: Character := C1; + begin C1 := C2; C2 := T; end Swap; + begin + for OI in S'First+1..S'Last loop + No_Swaps := True; + for II in reverse OI..S'Last loop + if S(II) < S(II-1) then + Swap(S(II),S(II-1)); + No_Swaps := False; + end if; + end loop; + exit when No_Swaps; + end loop; + end Sort_String; + + procedure Validate( Expected: String; + Message : String; + Order_Meaningful : Boolean := True) is + Want : String(1..Expected'Length) := Expected; + begin + if not Order_Meaningful then + Sort_String( Want ); + Sort_String( Collection(1..Finger) ); + end if; + if Collection(1..Finger) /= Want then + Report.Failed( Message & " Expecting: " & Want + & " Got: " & Collection(1..Finger) ); + end if; + Finger := 0; + end Validate; + + procedure Flush is + begin + Finger := 0; + end Flush; + + procedure Implementation_Check( Message : in String; + Annex : in Special_Needs_Annexes + := Annex_C ) is + -- default to cover some legacy + -- USAGE DISCIPLINE: + -- Implementation_Check is designed to be used in tests that have + -- interdependency on one of the Special Needs Annexes, yet are _really_ + -- tests based in the core language. There will be instances where the + -- execution of a test would be failing in the light of the requirements + -- of the annex, yet from the point of view of the core language without + -- the additional requirements of the annex, the test does not apply. + -- In these cases, rather than issuing a call to Report.Failed, calling + -- TCTouch.Implementation_Check will check that sensitivity, and if + -- the implementation is attempting to validate against the specific + -- annex, Report.Failed will be called, otherwise, Report.Not_Applicable + -- will be called. + begin + + case Annex is + when Annex_C => + if ImpDef.Validating_Annex_C then + Report.Failed( Message ); + else + Report.Not_Applicable( Message & " Annex C not supported" ); + end if; + + when Annex_D => + if ImpDef.Validating_Annex_D then + Report.Failed( Message ); + else + Report.Not_Applicable( Message & " Annex D not supported" ); + end if; + + when Annex_E => + if ImpDef.Validating_Annex_E then + Report.Failed( Message ); + else + Report.Not_Applicable( Message & " Annex E not supported" ); + end if; + + when Annex_F => + if ImpDef.Validating_Annex_F then + Report.Failed( Message ); + else + Report.Not_Applicable( Message & " Annex F not supported" ); + end if; + + when Annex_G => + if ImpDef.Validating_Annex_G then + Report.Failed( Message ); + else + Report.Not_Applicable( Message & " Annex G not supported" ); + end if; + + when Annex_H => + if ImpDef.Validating_Annex_H then + Report.Failed( Message ); + else + Report.Not_Applicable( Message & " Annex H not supported" ); + end if; + end case; + end Implementation_Check; + + end TCTouch; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/tsttests.dat gcc-3.4.0/gcc/testsuite/ada/acats/support/tsttests.dat *** gcc-3.3.3/gcc/testsuite/ada/acats/support/tsttests.dat 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/tsttests.dat 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,38 ---- + ACATS4GNATDIR/tests/a/a26007a.tst + ACATS4GNATDIR/tests/a/ad8011a.tst + ACATS4GNATDIR/tests/c2/c23003a.tst + ACATS4GNATDIR/tests/c2/c23003b.tst + ACATS4GNATDIR/tests/c2/c23003g.tst + ACATS4GNATDIR/tests/c2/c23003i.tst + ACATS4GNATDIR/tests/c3/c35502d.tst + ACATS4GNATDIR/tests/c3/c35502f.tst + ACATS4GNATDIR/tests/c3/c35503d.tst + ACATS4GNATDIR/tests/c3/c35503f.tst + ACATS4GNATDIR/tests/c4/c45231d.tst + ACATS4GNATDIR/tests/c4/c4a007a.tst + ACATS4GNATDIR/tests/c8/c87b62d.tst + ACATS4GNATDIR/tests/c9/c96005b.tst + ACATS4GNATDIR/tests/cc/cc1225a.tst + ACATS4GNATDIR/tests/cd/cd1009k.tst + ACATS4GNATDIR/tests/cd/cd1009t.tst + ACATS4GNATDIR/tests/cd/cd1009u.tst + ACATS4GNATDIR/tests/cd/cd1c03e.tst + ACATS4GNATDIR/tests/cd/cd1c06a.tst + ACATS4GNATDIR/tests/cd/cd2a83c.tst + ACATS4GNATDIR/tests/cd/cd2a91c.tst + ACATS4GNATDIR/tests/cd/cd2c11a.tst + ACATS4GNATDIR/tests/cd/cd2c11d.tst + ACATS4GNATDIR/tests/cd/cd4041a.tst + ACATS4GNATDIR/tests/cd/cd7101g.tst + ACATS4GNATDIR/tests/ce/ce2102c.tst + ACATS4GNATDIR/tests/ce/ce2102h.tst + ACATS4GNATDIR/tests/ce/ce2103a.tst + ACATS4GNATDIR/tests/ce/ce2103b.tst + ACATS4GNATDIR/tests/ce/ce2203a.tst + ACATS4GNATDIR/tests/ce/ce2403a.tst + ACATS4GNATDIR/tests/ce/ce3002b.tst + ACATS4GNATDIR/tests/ce/ce3002c.tst + ACATS4GNATDIR/tests/ce/ce3102b.tst + ACATS4GNATDIR/tests/ce/ce3107a.tst + ACATS4GNATDIR/tests/ce/ce3304a.tst + ACATS4GNATDIR/support/spprt13s.tst diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/support/widechr.a gcc-3.4.0/gcc/testsuite/ada/acats/support/widechr.a *** gcc-3.3.3/gcc/testsuite/ada/acats/support/widechr.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/support/widechr.a 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,294 ---- + -- WIDECHR.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. + --* + -- + -- DESCRIPTION: + -- + -- This program reads C250001.AW and C250002.AW; translates a special + -- character sequence into characters and wide characters with positions + -- above ASCII.DEL. The resulting tests are written as C250001.A and + -- C250002.A respectively. This program may need to + -- be modified if the Wide_Character representation recognized by + -- your compiler differs from the Wide_Character + -- representation generated by the package Ada.Wide_Text_IO. + -- Modify this program as needed to translate that file. + -- + -- A wide character is represented by an 8 character sequence: + -- + -- ["abcd"] + -- + -- where the character code represented is specified by four hexadecimal + -- digits, abcd, with letters in upper case. For example the wide + -- character with the code 16#AB13# is represented by the eight + -- character sequence: + -- + -- ["AB13"] + -- + -- ASSUMPTIONS: + -- + -- The path for these files is specified in ImpDef. + -- + -- SPECIAL REQUIREMENTS: + -- + -- Compile, bind and execute this program. It will process the ".AW" + -- tests, "translating" them to ".A" tests. + -- + -- CHANGE HISTORY: + -- 11 DEC 96 SAIC ACVC 2.1 Release + -- + -- 11 DEC 96 Keith Constructed initial release version + --! + + with Ada.Text_IO; + with Ada.Wide_Text_IO; + with Ada.Strings.Fixed; + with Impdef; + + procedure WideChr is + + -- Debug + -- + -- To have the program generate trace/debugging information, de-comment + -- the call to Put_Line + + procedure Debug( S: String ) is + begin + null; -- Ada.Text_IO.Put_Line(S); + end Debug; + + package TIO renames Ada.Text_IO; + package WIO renames Ada.Wide_Text_IO; + package SF renames Ada.Strings.Fixed; + + In_File : TIO.File_Type; + + -- This program is actually dual-purpose. It translates the ["xxxx"] + -- notation to Wide_Character, as well as a similar notation ["xx"] into + -- Character. The intent of the latter being the ability to represent + -- literals in the Latin-1 character set that have position numbers + -- greater than ASCII.DEL. The variable Output_Mode drives the algorithms + -- to generate Wide_Character output (Wide) or Character output (Narrow). + + type Output_Modes is ( Wide, Narrow ); + Output_Mode : Output_Modes := Wide; + + Wide_Out : WIO.File_Type; + Narrow_Out : TIO.File_Type; + + In_Line : String(1..132); -- SB: $MAX_LINE_LENGTH + + -- Index variables + -- + -- the following index variables: In_Length, Front, Open_Bracket and + -- Close_Bracket are used by the scanning software to keep track of + -- what's where. + -- + -- In_Length stores the value returned by Ada.Text_IO.Get_Line indicating + -- the position of the last "useful" character in the string In_Line. + -- + -- Front retains the index of the first non-translating character in + -- In_Line, it is used to indicate the starting index of the portion of + -- the string to save without special interpretation. In the example + -- below, where there are two consecutive characters to translate, we see + -- that Front will assume three different values processing the string, + -- these are indicated by the digits '1', '2' & '3' in the comment + -- attached to the declaration. The processing software will dump + -- In_Line(Front..Open_Bracket-1) to the output stream. Note that in + -- the second case, this results in a null string, and in the third case, + -- where Open_Bracket does not obtain a third value, the slice + -- In_Line(Front..In_Length) is used instead. + -- + -- Open_Bracket and Close_Bracket are used to retain the starting index + -- of the character pairs [" and "] respectively. For the purposes of + -- this software the character pairs are what are considered to be the + -- "brackets" enclosing the hexadecimal values to be translated. + -- Looking at the example below you will see where these index variables + -- will "point" in the first and second case. + + In_Length : Natural := 0; ---> Some_["0A12"]["0B13"]_Thing + Front : Natural := 0; -- 1 2 3 + Open_Bracket : Natural := 0; -- 1 2 + Close_Bracket : Natural := 0; -- 1 2 + + -- Xlation + -- + -- This translation table gives an easy way to translate the "decimal" + -- value of a hex digit (as represented by a Latin-1 character) + + type Xlate is array(Character range '0'..'F') of Natural; + Xlation : constant Xlate := + ('0' => 0, '1' => 1, '2' => 2, '3' => 3, '4' => 4, + '5' => 5, '6' => 6, '7' => 7, '8' => 8, '9' => 9, + 'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14, + 'F' => 15, + others => 0); + + -- To_Ch + -- + -- This function takes a string which is assumed to be trimmed to just a + -- hexadecimal representation of a Latin-1 character. The result of the + -- function is the Latin-1 character at the position designated by the + -- incoming hexadecimal value. (hexadecimal in human readable form) + + function To_Ch( S:String ) return Character is + Numerical : Natural := 0; + begin + Debug("To Wide: " & S); + for I in S'Range loop + Numerical := Numerical * 16 + Xlation(S(I)); + end loop; + return Character'Val(Numerical); + exception + when Constraint_Error => return '_'; + end To_Ch; + + -- To_Wide + -- + -- This function takes a string which is assumed to be trimmed to just a + -- hexadecimal representation of a Wide_character. The result of the + -- function is the Wide_character at the position designated by the + -- incoming hexadecimal value. (hexadecimal in human readable form) + + function To_Wide( S:String ) return Wide_character is + Numerical : Natural := 0; + begin + Debug("To Wide: " & S); + for I in S'Range loop + Numerical := Numerical * 16 + Xlation(S(I)); + end loop; + return Wide_Character'Val(Numerical); + exception + when Constraint_Error => return '_'; + end To_Wide; + + -- Make_Wide + -- + -- this function converts a String to a Wide_String + + function Make_Wide( S: String ) return Wide_String is + W: Wide_String(S'Range); + begin + for I in S'Range loop + W(I) := Wide_Character'Val( Character'Pos(S(I)) ); + end loop; + return W; + end Make_Wide; + + -- Close_Files + -- + -- Depending on which input we've processed, close the output file + + procedure Close_Files is + begin + TIO.Close(In_File); + if Output_Mode = Wide then + WIO.Close(Wide_Out); + else + TIO.Close(Narrow_Out); + end if; + end Close_Files; + + -- Process + -- + -- for all lines in the input file + -- scan the file for occurrences of [" and "] + -- for found occurrence, attempt translation of the characters found + -- between the brackets. As a safeguard, unrecognizable character + -- sequences will be replaced with the underscore character. This + -- handles the cases in the tests where the test documentation includes + -- examples that are non-conformant: i.e. ["abcd"] or ["XXXX"] + + procedure Process( Input_File_Name: String ) is + begin + TIO.Open(In_File,TIO.In_File,Input_File_Name & ".aw" ); + + if Output_Mode = Wide then + WIO.Create(Wide_Out,WIO.Out_File, Input_File_Name & ".a" ); + else + TIO.Create(Narrow_Out,TIO.Out_File, Input_File_Name & ".a" ); + end if; + + File: while not TIO.End_Of_File( In_File ) loop + In_Line := (others => ' '); + TIO.Get_Line(In_File,In_Line,In_Length); + Debug(In_Line(1..In_Length)); + + Front := 1; + + Line: loop + -- scan for next occurrence of ["abcd"] + Open_Bracket := SF.Index( In_Line(Front..In_Length), "[""" ); + Close_Bracket := SF.Index( In_Line(Front..In_Length), """]" ); + Debug( "[=" & Natural'Image(Open_Bracket) ); + Debug( "]=" & Natural'Image(Close_Bracket) ); + + if Open_Bracket = 0 or Close_Bracket = 0 then + -- done with the line, output remaining characters and exit + Debug("Done with line"); + if Output_Mode = Wide then + WIO.Put_Line(Wide_Out, Make_Wide(In_Line(Front..In_Length)) ); + else + TIO.Put_Line(Narrow_Out, In_Line(Front..In_Length) ); + end if; + exit Line; + else + -- output the "normal" stuff up to the bracket + if Output_Mode = Wide then + WIO.Put(Wide_Out, Make_Wide(In_Line(Front..Open_Bracket-1)) ); + else + TIO.Put(Narrow_Out, In_Line(Front..Open_Bracket-1) ); + end if; + + -- point beyond the closing bracket + Front := Close_Bracket +2; + + -- output the translated hexadecimal character + if Output_Mode = Wide then + WIO.Put(Wide_Out, + To_Wide( In_Line(Open_Bracket+2..Close_Bracket-1) )); + else + TIO.Put(Narrow_Out, + To_Ch( In_Line(Open_Bracket+2..Close_Bracket-1)) ); + end if; + end if; + end loop Line; + + end loop File; + + Close_Files; + exception + when others => + Ada.Text_IO.Put_Line("Error in processing " & Input_File_Name); + raise; + end Process; + + begin + + Output_Mode := Wide; + Process( Impdef.Wide_Character_Test ); + + Output_Mode := Narrow; + Process( Impdef.Upper_Latin_Test ); + + end WideChr; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a22006b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a22006b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a22006b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a22006b.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,38 ---- + -- A22006B.ADA + + -- 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. + --* + -- CHECK THAT HORIZONTAL TABULATION CAN BE USED WITHIN AND OUTSIDE OF + -- COMMENTS. + + -- JBG 5/26/85 + + WITH REPORT; USE REPORT; + PROCEDURE A22006B IS + BEGIN + TEST ("A22006B", "CHECK USE OF HT IN AND OUT OF COMMENTS"); + -- PRECEDING LINE CONTAINED A LEADING HT + -- NEXT LINE CONTAINS A TAB INSIDE A COMMENT + -- HERE IS HT => <= CHARACTER IN A COMMENT + RESULT; -- TAB PRECEDES THIS COMMENT + END A22006B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a22006c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a22006c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a22006c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a22006c.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,51 ---- + + + + -- A22006C.ADA + + -- 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. + --* + -- CHECK THAT A COMPILATION MAY BE PRECEDED BY EXTRA LINES + -- (INCLUDING LINES TERMINATED BY FORMAT EFFECTORS OTHER + -- THAN HORIZONTAL TABULATION). + + -- NOTE: THIS FILE BEGINS WITH: + -- 1) AN EMPTY LINE + -- 2) A CARRIAGE RETURN CHARACTER (ASCII 13. = 0D HEX) + -- 3) A CARRIAGE RETURN CHARACTER (ASCII 13. = 0D HEX) + -- 4) A VERTICAL TABULATION CHARACTER (ASCII 11. = 0B HEX) + -- 5) A LINE FEED CHARACTER (ASCII 10. = 0A HEX) + -- 6) A LINE FEED CHARACTER (ASCII 10. = 0A HEX) + -- 7) A FORM FEED CHARACTER (ASCII 12. = 0C HEX) + + -- PWB 2/13/86 + + WITH REPORT; + USE REPORT; + + PROCEDURE A22006C IS + BEGIN + TEST ("A22006C", "CHECK THAT A COMPILATION CAN BE PRECEDED " & + "BY EXTRA LINES"); + RESULT; + END A22006C; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a22006d.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a22006d.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a22006d.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a22006d.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,41 ---- + -- A22006D.ADA + + -- 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. + --* + -- CHECK THAT A COMPILATION CAN BE PRECEDED BY SPACES AND + -- HORIZONTAL TABULATION CHARACTERS. + + -- NOTE: THE FIRST LINE OF THIS FILE BEGINS WITH FOUR SPACE + -- CHARACTERS AND A HORIZONTAL TABULATION CHARACTER + + -- PWB 2/13/86 + + WITH REPORT; + USE REPORT; + + PROCEDURE A22006D IS + BEGIN + TEST ("A22006D", "CHECK THAT A COMPILATION CAN BE PRECEDED " & + "BY SPACE AND HORIZONTAL TABULATION CHARACTERS"); + RESULT; + END A22006D; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a26007a.tst gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a26007a.tst *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a26007a.tst 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a26007a.tst 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,48 ---- + -- A26007A.TST + + -- 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. + --* + -- CHECK THAT A STRING LITERAL HAVING THE MAXIMUM PERMITTED LINE LENGTH + -- CAN BE GENERATED. + + -- TBN 3/5/86 + + WITH REPORT; USE REPORT; + PROCEDURE A26007A IS + + MAX_LEN_STRING_LIT : STRING (1 .. $MAX_IN_LEN - 2); + + -- MAX_IN_LEN IS THE MAXIMUM LINE LENGTH PERMITTED. + + BEGIN + TEST ("A26007A", "CHECK THAT A STRING LITERAL HAVING THE " & + "MAXIMUM PERMITTED LINE LENGTH CAN BE GENERATED"); + + MAX_LEN_STRING_LIT := + $MAX_STRING_LITERAL + ; + -- MAX_STRING_LITERAL IS A STRING LITERAL THAT IS MAXIMUM LENGTH. + -- QUOTES ARE COUNTED AS PART OF THE STRING LITERAL. + + RESULT; + END A26007A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a27003a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a27003a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a27003a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a27003a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,51 ---- + -- A27003A.ADA + + -- 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. + --* + -- CHECK THAT IN A STRING LITERAL, CONSECUTIVE HYPHENS + -- ARE PERMITTED WITHOUT INDICATING A COMMENT, + -- AND THAT IN A COMMENT, A SINGLE DOUBLE-QUOTE IS + -- PERMITTED WITHOUT INDICATING A STRING LITERAL. + + -- PWB 03/04/86 + + WITH REPORT; USE REPORT; + PROCEDURE A27003A IS + + -- COMMENT : " IS PERMITTED HERE. + + STR1 : CONSTANT STRING := "AB--C"; + STR2 : STRING (1..10); + + BEGIN + + TEST ("A27003A", "CONSECUTIVE HYPHENS PERMITTED IN " & + "STRING LITERAL, AND QUOTE PERMITTED " & + "IN COMMENT"); + + STR2 := STR1 & "--ABC"; + -- COMMENT : " IS PERMITTED HERE. + + RESULT; + + END A27003A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a29003a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a29003a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a29003a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a29003a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,102 ---- + -- A29003A.ADA + + -- 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. + --* + -- CHECK THAT ALL PREDEFINED ATTRIBUTES EXCEPT DIGITS, DELTA, AND RANGE, + -- AND ALL PREDEFINED TYPE AND PACKAGE NAMES ARE NOT RESERVED WORDS. + + -- AH 8/11/86 + + WITH REPORT; USE REPORT; + PROCEDURE A29003A IS + SUBTYPE INT IS INTEGER; + + -- PREDEFINED ATTRIBUTES + + ADDRESS : INT := IDENT_INT(0); -- ATTRIBUTE + AFT : INT := IDENT_INT(0); -- ATTRIBUTE + BASE : INT := IDENT_INT(0); -- ATTRIBUTE + CALLABLE : INT := IDENT_INT(0); -- ATTRIBUTE + CONSTRAINED : INT := IDENT_INT(0); -- ATTRIBUTE + COUNT : INT := IDENT_INT(0); -- ATTRIBUTE + EMAX : INT := IDENT_INT(0); -- ATTRIBUTE + EPSILON : INT := IDENT_INT(0); -- ATTRIBUTE + FIRST : INT := IDENT_INT(0); -- ATTRIBUTE + FIRST_BIT : INT := IDENT_INT(0); -- ATTRIBUTE + FORE : INT := IDENT_INT(0); -- ATTRIBUTE + IMAGE : INT := IDENT_INT(0); -- ATTRIBUTE + LARGE : INT := IDENT_INT(0); -- ATTRIBUTE + LAST : INT := IDENT_INT(0); -- ATTRIBUTE + LAST_BIT : INT := IDENT_INT(0); -- ATTRIBUTE + LENGTH : INT := IDENT_INT(0); -- ATTRIBUTE + MACHINE_EMAX : INT := IDENT_INT(0); -- ATTRIBUTE + MACHINE_EMIN : INT := IDENT_INT(0); -- ATTRIBUTE + MACHINE_MANTISSA : INT := IDENT_INT(0); -- ATTRIBUTE + MACHINE_OVERFLOWS : INT := IDENT_INT(0); -- ATTRIBUTE + MACHINE_RADIX : INT := IDENT_INT(0); -- ATTRIBUTE + MACHINE_ROUNDS : INT := IDENT_INT(0); -- ATTRIBUTE + MANTISSA : INT := IDENT_INT(0); -- ATTRIBUTE + POS : INT := IDENT_INT(0); -- ATTRIBUTE + POSITION : INT := IDENT_INT(0); -- ATTRIBUTE + PRED : INT := IDENT_INT(0); -- ATTRIBUTE + SAFE_EMAX : INT := IDENT_INT(0); -- ATTRIBUTE + SAFE_LARGE : INT := IDENT_INT(0); -- ATTRIBUTE + SAFE_SMALL : INT := IDENT_INT(0); -- ATTRIBUTE + SIZE : INT := IDENT_INT(0); -- ATTRIBUTE + SMALL : INT := IDENT_INT(0); -- ATTRIBUTE + STORAGE_SIZE : INT := IDENT_INT(0); -- ATTRIBUTE + SUCC : INT := IDENT_INT(0); -- ATTRIBUTE + TERMINATED : INT := IDENT_INT(0); -- ATTRIBUTE + VAL : INT := IDENT_INT(0); -- ATTRIBUTE + VALUE : INT := IDENT_INT(0); -- ATTRIBUTE + WIDTH : INT := IDENT_INT(0); -- ATTRIBUTE + + -- PREDEFINED TYPES + + BOOLEAN : INT := IDENT_INT(0); -- TYPE + CHARACTER : INT := IDENT_INT(0); -- TYPE + DURATION : INT := IDENT_INT(0); -- TYPE + FLOAT : INT := IDENT_INT(0); -- TYPE + INTEGER : INT := IDENT_INT(0); -- TYPE + NATURAL : INT := IDENT_INT(0); -- TYPE + POSITIVE : INT := IDENT_INT(0); -- TYPE + STRING : INT := IDENT_INT(0); -- TYPE + + -- PREDEFINED PACKAGE NAMES + + ASCII : INT := IDENT_INT(0); -- PACKAGE + CALENDAR : INT := IDENT_INT(0); -- PACKAGE + DIRECT_IO : INT := IDENT_INT(0); -- PACKAGE + IO_EXCEPTIONS : INT := IDENT_INT(0); -- PACKAGE + LOW_LEVEL_IO : INT := IDENT_INT(0); -- PACKAGE + MACHINE_CODE : INT := IDENT_INT(0); -- PACKAGE + SEQUENTIAL_IO : INT := IDENT_INT(0); -- PACKAGE + SYSTEM : INT := IDENT_INT(0); -- PACKAGE + TEXT_IO : INT := IDENT_INT(0); -- PACKAGE + UNCHECKED_CONVERSION : INT := IDENT_INT(0); -- PACKAGE + UNCHECKED_DEALLOCATION : INT := IDENT_INT(0); -- PACKAGE + + BEGIN + TEST("A29003A", "NO ADDITIONAL RESERVED WORDS"); + RESULT; + END A29003A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a2a031a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a2a031a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a2a031a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a2a031a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,72 ---- + -- A2A031A.ADA + + -- 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. + --* + -- CHECK THAT AN EXCLAMATION MARK CAN REPLACE A VERTICAL BAR WHEN THE + -- VERTICAL BAR IS USED AS A SEPARATOR. + + -- CONTEXTS ARE: + -- AS A CHOICE IN A VARIANT PART + -- IN A DISCRIMINANT CONSTRAINT + -- IN A CASE STATEMENT CHOICE + -- IN AN AGGREGATE + -- IN AN EXCEPTION HANDLER. + + -- JBG 5/25/85 + + WITH REPORT; USE REPORT; + PROCEDURE A2A031A IS + + TYPE ENUM IS (E1, E2, E3); + TYPE REC (A, B : ENUM) IS + RECORD + C : INTEGER; + CASE A IS + WHEN E1 ! E2 => -- CHOICE OF VARIANT. + D : INTEGER; + WHEN E3 => + E : FLOAT; + END CASE; + END RECORD; + + EX1, EX2, EX3 : EXCEPTION; + + VAR : REC (A!B => E2); -- DISCRIMINANT CONSTRAINT. + + EVAR : ENUM := E2; + + BEGIN + + TEST ("A2A031A", "CHECK USE OF ! AS SEPARATOR IN PLACE OF |"); + + CASE EVAR IS + WHEN E3 => NULL; + WHEN E2!E1 => NULL; -- CASE STATEMENT CHOICE. + END CASE; + + VAR := (A!B => E2, C ! D => 0); -- AGGREGATE. + + RESULT; + EXCEPTION + WHEN EX1!EX2 ! EX3 => NULL; -- EXCEPTION HANDLER. + END A2A031A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a33003a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a33003a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a33003a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a33003a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,49 ---- + -- A33003A.ADA + + -- 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. + --* + -- CHECK THAT THE FOLLOWING FORMS OF ALMOST RECURSIVE TYPES CAN BE + -- DECLARED: + -- A) A RECORD HAVING A COMPONENT OF AN ACCESS TYPE WHOSE DESIGNATED + -- TYPE IS THE RECORD TYPE; + + -- TBN 10/6/86 + -- DTN 11/12/91 DELETED SUBPARTS (B and C). + + WITH REPORT; USE REPORT; + PROCEDURE A33003A IS + + TYPE REC; + TYPE ACC_REC IS ACCESS REC; + TYPE REC IS + RECORD + A : INTEGER; + B : ACC_REC; + END RECORD; + + BEGIN + TEST ("A33003A", "CHECK THAT ALMOST RECURSIVE TYPES CAN BE " & + "DECLARED"); + + RESULT; + END A33003A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a34017c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a34017c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a34017c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a34017c.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,105 ---- + -- A34017C.ADA + + -- 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. + --* + -- CHECK THAT IF A DERIVED TYPE DEFINITION IS GIVEN IN THE VISIBLE PART + -- OF A PACKAGE, THE TYPE MAY BE USED AS THE PARENT TYPE IN A DERIVED + -- TYPE DEFINITION IN THE PRIVATE PART OF THE PACKAGE AND IN THE BODY. + + -- CHECK THAT IF A TYPE IS DECLARED IN THE VISIBLE PART OF A PACKAGE, + -- AND IS NOT A DERIVED TYPE OR A PRIVATE TYPE, IT MAY BE USED AS THE + -- PARENT TYPE IN A DERIVED TYPE DEFINITION IN THE VISIBLE PART, PRIVATE + -- PART, AND BODY. + + + -- DSJ 4/27/83 + + + WITH REPORT; + PROCEDURE A34017C IS + + USE REPORT; + + BEGIN + + TEST( "A34017C", "CHECK THAT A DERIVED TYPE MAY BE USED AS A " & + "PARENT TYPE IN THE PRIVATE PART AND BODY. " & + "CHECK THAT OTHER TYPES MAY BE USED AS PARENT " & + "TYPES IN VISIBLE PART ALSO"); + + DECLARE + + TYPE REC IS + RECORD + C : INTEGER; + END RECORD; + + PACKAGE PACK1 IS + + TYPE T1 IS RANGE 1 .. 10; + TYPE T2 IS NEW REC; + + TYPE T3 IS (A,B,C); + TYPE T4 IS ARRAY ( 1 .. 2 ) OF INTEGER; + TYPE T5 IS + RECORD + X : CHARACTER; + END RECORD; + TYPE T6 IS ACCESS INTEGER; + + TYPE N1 IS NEW T3; + TYPE N2 IS NEW T4; + TYPE N3 IS NEW T5; + TYPE N4 IS NEW T6; + + PRIVATE + + TYPE P1 IS NEW T1; + TYPE P2 IS NEW T2; + TYPE P3 IS NEW T3; + TYPE P4 IS NEW T4; + TYPE P5 IS NEW T5; + TYPE P6 IS NEW T6; + + END PACK1; + + PACKAGE BODY PACK1 IS + + TYPE Q1 IS NEW T1; + TYPE Q2 IS NEW T2; + TYPE Q3 IS NEW T3; + TYPE Q4 IS NEW T4; + TYPE Q5 IS NEW T5; + TYPE Q6 IS NEW T6; + + END PACK1; + + BEGIN + + NULL; + + END; + + RESULT; + + END A34017C; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a35101b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a35101b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a35101b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a35101b.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,50 ---- + -- A35101B.ADA + + -- 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. + --* + -- CHECK THAT ONE ENUMERATION LITERAL IS PERMITTED IN AN ENUMERATION + -- TYPE DEFINITION. + + -- RJW 2/14/86 + + WITH REPORT; USE REPORT; + + PROCEDURE A35101B IS + + BEGIN + + TEST ("A35101B", "CHECK THAT ONE ENUMERATION LITERAL IS " & + "PERMITTED IN AN ENUMERATION TYPE " & + "DEFINITION" ); + DECLARE + + TYPE E1 IS (A); -- OK. + TYPE E2 IS ('1'); -- OK. + + BEGIN + NULL; + END; + + RESULT; + + END A35101B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a35402a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a35402a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a35402a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a35402a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,63 ---- + -- A35402A.ADA + + -- 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. + --* + -- CHECK THAT THE BOUNDS OF AN INTEGER TYPE DEFINITION NEED NOT + -- HAVE THE SAME INTEGER TYPE. + + -- RJW 2/20/86 + + WITH REPORT; USE REPORT; + + PROCEDURE A35402A IS + + BEGIN + + TEST ( "A35402A", "CHECK THAT THE BOUNDS OF AN INTEGER " & + "TYPE DEFINITION NEED NOT HAVE THE SAME " & + "INTEGER TYPE" ); + + DECLARE + TYPE INT1 IS RANGE 1 .. 10; + TYPE INT2 IS RANGE 2 .. 8; + TYPE INT3 IS NEW INTEGER; + + I : CONSTANT INTEGER := 5; + I1 : CONSTANT INT1 := 5; + I2 : CONSTANT INT2 := 5; + I3 : CONSTANT INT3 := 5; + + TYPE INTRANGE1 IS RANGE I .. I1; -- OK. + + TYPE INTRANGE2 IS RANGE I1 .. I2; -- OK. + + TYPE INTRANGE3 IS RANGE I2 .. I3; -- OK. + + TYPE INTRANGE4 IS RANGE I3 .. I; -- OK. + BEGIN + NULL; + END; + + RESULT; + + END A35402A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a35801f.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a35801f.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a35801f.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a35801f.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,64 ---- + -- A35801F.ADA + + -- 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. + --* + -- CHECK THAT THE ATTRIBUTES FIRST AND LAST RETURN VALUES HAVING THE + -- SAME BASE TYPE AS THE PREFIX WHEN THE PREFIX IS A FLOATING POINT + -- TYPE. + + -- THIS CHECK IS PROVIDED THROUGH THE USE OF THIS TEST IN CONJUNCTION + -- WITH TEST B35801C. + + -- R.WILLIAMS 8/21/86 + + WITH REPORT; USE REPORT; + PROCEDURE A35801F IS + + TYPE REAL IS DIGITS 3 RANGE -100.0 .. 100.0; + SUBTYPE SURREAL IS REAL RANGE -50.0 .. 50.0; + + TYPE NFLT IS NEW FLOAT; + SUBTYPE UNIT IS NFLT RANGE -1.0 .. 1.0; + + SUBTYPE EMPTY IS FLOAT RANGE 1.0 .. -1.0; + + R1 : REAL := SURREAL'FIRST; -- OK. + R2 : REAL := SURREAL'LAST; -- OK. + + N1 : NFLT := UNIT'FIRST; -- OK. + N2 : NFLT := UNIT'LAST; -- OK. + + F1 : FLOAT := FLOAT'FIRST; -- OK. + F2 : FLOAT := FLOAT'LAST; -- OK. + + E1 : FLOAT := EMPTY'FIRST; -- OK. + E2 : FLOAT := EMPTY'LAST; -- OK. + + BEGIN + TEST ( "A35801F", "CHECK THAT THE ATTRIBUTES FIRST AND LAST " & + "RETURN VALUES HAVING THE SAME BASE TYPE AS " & + "THE PREFIX WHEN THE PREFIX IS A FLOATING " & + "POINT TYPE" ); + + RESULT; + END A35801F; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a35902c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a35902c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a35902c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a35902c.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,51 ---- + -- A35902C.ADA + + -- 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 A FIXED POINT TYPE WITH ONLY ONE MODEL NUMBER IS + -- ALLOWED. + + -- HISTORY: + -- RJW 02/26/86 CREATED ORIGINAL TEST. + -- DHH 10/15/87 CORRECTED RANGE ERRORS. + + WITH REPORT; USE REPORT; + + PROCEDURE A35902C IS + + BEGIN + + TEST ("A35902C", "CHECK THAT A FIXED POINT TYPE WITH ONLY ONE " & + "MODEL NUMBER IS ALLOWED" ); + DECLARE + TYPE F IS DELTA 1.0 RANGE -0.5 .. 0.5; -- OK. + F1 : F := 0.0; + + BEGIN + NULL; + END; + + RESULT; + + END A35902C; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a38106d.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a38106d.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a38106d.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a38106d.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,99 ---- + -- A38106D.ADA + + -- 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. + --* + -- CHECK THAT FOR AN ACCESS TYPE WHOSE DESIGNATED TYPE IS AN INCOMPLETE + -- TYPE, ADDITIONAL OPERATIONS FOR THE ACCESS TYPE WHICH DEPEND ON + -- CHARACTERISTICS OF THE FULL DECLARATION OF THE TYPE ARE MADE + -- AVAILABLE AT THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE + -- ACCESS TYPE DECLARATION AND AFTER THE FULL DECLARATION OF THE + -- INCOMPLETE TYPE. + + -- (1) CHECK FOR COMPONENT SELECTION WITH RECORD TYPES + -- (2) CHECK FOR INDEXED COMPONENTS AND SLICES WITH ARRAY TYPES + -- (3) CHECK FOR USE OF 'FIRST, 'LAST, 'RANGE, AND 'LENGTH WITH ARRAY + -- TYPES + + -- PART 1: FULL DECLARATION OF INCOMPLETE TYPE IN PACKAGE SPECIFICATION. + + -- DSJ 5/05/83 + -- SPS 10/18/83 + -- EG 12/19/83 + + WITH REPORT ; + PROCEDURE A38106D IS + + USE REPORT ; + + BEGIN + + TEST("A38106D", "CHECK THAT ADDITIONAL OPERATIONS OF ACCESS " & + "TYPES OF INCOMPLETE TYPES ARE AVAILABLE AT THE " & + "EARLIEST PLACE IN THE IMMEDIATE SCOPE OF THE " & + "ACCESS TYPE AND AFTER THE FULL DECLARATION " & + "(WHICH IS IN THE PACKAGE SPECIFICATION)") ; + + DECLARE + + PACKAGE PACK1 IS + TYPE T1 ; + TYPE T2 ; + + PACKAGE PACK2 IS + TYPE ACC1 IS ACCESS T1 ; + TYPE ACC2 IS ACCESS T2 ; + END PACK2 ; + + TYPE T1 IS ARRAY ( 1 .. 2 ) OF INTEGER ; + TYPE T2 IS + RECORD + C1, C2 : INTEGER ; + END RECORD ; + END PACK1 ; + + PACKAGE BODY PACK1 IS + A1 : PACK2.ACC1 := NEW T1'(2,4) ; -- LEGAL + A2 : PACK2.ACC1 := NEW T1'(6,8) ; -- LEGAL + R1 : PACK2.ACC2 := NEW T2'(3,5) ; -- LEGAL + R2 : PACK2.ACC2 := NEW T2'(7,9) ; -- LEGAL + + PACKAGE BODY PACK2 IS + X1 : INTEGER := A1(1) ; -- LEGAL + X2 : INTEGER := A1'FIRST ; -- LEGAL + X3 : INTEGER := A1'LAST ; -- LEGAL + X4 : INTEGER := A1'LENGTH ; -- LEGAL + B1 : BOOLEAN := 3 IN A1'RANGE ; -- LEGAL + X5 : INTEGER := R1.C1 ; -- LEGAL + END PACK2 ; + + END PACK1 ; + + BEGIN + + NULL ; + + END ; + + RESULT ; + + END A38106D ; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a38106e.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a38106e.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a38106e.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a38106e.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,99 ---- + -- A38106E.ADA + + -- 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. + --* + -- CHECK THAT FOR AN ACCESS TYPE WHOSE DESIGNATED TYPE IS AN INCOMPLETE + -- TYPE, ADDITIONAL OPERATIONS FOR THE ACCESS TYPE WHICH DEPEND ON + -- CHARACTERISTICS OF THE FULL DECLARATION OF THE TYPE ARE MADE + -- AVAILABLE AT THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE + -- ACCESS TYPE DECLARATION AND AFTER THE FULL DECLARATION OF THE + -- INCOMPLETE TYPE. + + -- (1) CHECK FOR COMPONENT SELECTION WITH RECORD TYPES + -- (2) CHECK FOR INDEXED COMPONENTS AND SLICES WITH ARRAY TYPES + -- (3) CHECK FOR USE OF 'FIRST, 'LAST, 'RANGE, AND 'LENGTH WITH ARRAY + -- TYPES + + -- PART 2 : FULL DECLARATION OF INCOMPLETE TYPE IN PACKAGE BODY + + -- DSJ 5/05/83 + -- SPS 10/18/83 + -- EG 12/19/83 + + WITH REPORT ; + PROCEDURE A38106E IS + + USE REPORT ; + + BEGIN + + TEST("A38106E", "CHECK THAT ADDITIONAL OPERATIONS OF ACCESS " & + "TYPES OF INCOMPLETE TYPES ARE AVAILABLE AT THE " & + "EARLIEST PLACE IN THE IMMEDIATE SCOPE OF THE " & + "ACCESS TYPE AND AFTER THE FULL DECLARATION " & + "(WHICH IS IN THE PACKAGE BODY)"); + + DECLARE + + PACKAGE PACK1 IS + PRIVATE + TYPE T1 ; + TYPE T2 ; + PACKAGE PACK2 IS + TYPE ACC1 IS ACCESS T1 ; + TYPE ACC2 IS ACCESS T2 ; + END PACK2 ; + END PACK1 ; + + PACKAGE BODY PACK1 IS + TYPE T1 IS ARRAY ( 1 .. 2 ) OF INTEGER ; + TYPE T2 IS + RECORD + C1, C2 : INTEGER ; + END RECORD ; + + A1 : PACK2.ACC1 := NEW T1'(2,4) ; -- LEGAL + A2 : PACK2.ACC1 := NEW T1'(6,8) ; -- LEGAL + R1 : PACK2.ACC2 := NEW T2'(3,5) ; -- LEGAL + R2 : PACK2.ACC2 := NEW T2'(7,9) ; -- LEGAL + + PACKAGE BODY PACK2 IS + X1 : INTEGER := A1(1) ; -- LEGAL + X2 : INTEGER := A1'FIRST ; -- LEGAL + X3 : INTEGER := A1'LAST ; -- LEGAL + X4 : INTEGER := A1'LENGTH ; -- LEGAL + B1 : BOOLEAN := 3 IN A1'RANGE ; -- LEGAL + X5 : INTEGER := R1.C1 ; -- LEGAL + END PACK2 ; + + END PACK1 ; + + BEGIN + + NULL ; + + END ; + + RESULT ; + + END A38106E ; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a49027a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a49027a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a49027a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a49027a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,85 ---- + -- A49027A.ADA + + -- 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. + --* + -- CHECK THAT A SUBTYPE CAN BE NONSTATIC IN A GENERIC TEMPLATE AND + -- STATIC IN THE CORRESPONDING INSTANCE. + -- CHECK THAT FOR A GENERIC INSTANTIATION, IF THE ACTUAL PARAMETER + -- IS A STATIC SUBTYPE, THEN EVERY USE OF THE CORRESPONDING FORMAL + -- PARAMETER WITHIN THE INSTANCE IS CONSIDERED TO DENOTE A STATIC + -- SUBTYPE + -- + -- THIS IS A TEST BASED ON AI-00409/05-BI-WJ. + + -- HISTORY: + -- EDWARD V. BERARD, 27 AUGUST 1990 + -- CJJ 10 OCT 1990 TEST OBJECTIVE CHANGED TO REFLECT AIG + -- OBJECTIVE. + + WITH REPORT ; + + PROCEDURE A49027A IS + + BEGIN -- A49027A + + REPORT.TEST ("A49027A", "CHECK THAT A SUBTYPE CAN BE NONSTATIC " & + "IN A GENERIC TEMPLATE AND STATIC IN THE " & + "CORRESPONDING INSTANCE.") ; + + LOCAL_BLOCK: + + DECLARE + + TYPE NUMBER IS RANGE 1 .. 10 ; + + GENERIC + + TYPE NUMBER_TYPE IS RANGE <> ; + + PACKAGE STATIC_TEST IS + + TYPE NEW_NUMBER_TYPE IS NEW NUMBER_TYPE ; + SUBTYPE SUB_NUMBER_TYPE IS NUMBER_TYPE ; + + END STATIC_TEST ; + + PACKAGE NEW_STATIC_TEST IS NEW STATIC_TEST + (NUMBER_TYPE => NUMBER) ; + + TYPE ANOTHER_NUMBER IS RANGE + NEW_STATIC_TEST.NEW_NUMBER_TYPE'FIRST .. + NEW_STATIC_TEST.NEW_NUMBER_TYPE'LAST ; + + TYPE YET_ANOTHER_NUMBER IS RANGE + NEW_STATIC_TEST.SUB_NUMBER_TYPE'FIRST .. + NEW_STATIC_TEST.SUB_NUMBER_TYPE'LAST ; + + BEGIN -- LOCAL_BLOCK + + NULL ; + + END LOCAL_BLOCK ; + + REPORT.RESULT ; + + END A49027A ; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a49027b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a49027b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a49027b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a49027b.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,159 ---- + -- A49027B.ADA + + -- 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 A SUBTYPE CAN BE NONSTATIC IN A GENERIC TEMPLATE + -- AND STATIC IN THE CORRESPONDING INSTANCE. + + -- CHECK THAT IF A GENERIC PARAMETER IS A STATIC EXPRESSION AND THE + -- CORRESPONDING (IN) PARAMETER HAS A STATIC SUBTYPE IN THE INSTANCE, + -- THEN EACH USE OF THE FORMAL PARAMETERS IN THE INSTANCE IS SAID TO + -- BE STATIC. + -- + -- A NAME DENOTING A CONSTANT DECLARED IN A GENERIC INSTANCE IS + -- ALLOWED AS A PRIMARY IN A STATIC EXPRESSION IF THE CONSTANT + -- IS DECLARED BY A CONSTANT DECLARATION WITH A STATIC SUBTYPE + -- AND INITIALIZED WITH A STATIC EXPRESSION. + -- + -- THIS IS A TEST BASED ON AI-00505/03-BI-WA. + + -- HISTORY: + -- EDWARD V. BERARD, 27 AUGUST 1990 + -- DAS 8 OCT 90 ADDED CODE TO MATCH EXAMPLE 1 IN + -- AI-00505. + -- JRL 05/29/92 CORRECTED MINOR PROBLEM IN REPORT.TEST STRING. + -- JRL 02/18/93 EXPANDED TEXT OF REPORT.TEST STRING. + -- PWN 04/14/95 CORRECTED MINOR COPYRIGHT COMMENT PROBLEM. + + + WITH REPORT ; + + PROCEDURE A49027B IS + + BEGIN -- A49027B + + REPORT.TEST ("A49027B", "CHECK THAT IF A GENERIC ACTUAL " & + "PARAMETER IS A STATIC EXPRESSION AND THE " & + "CORRESPONDING FORMAL PARAMETER HAS A STATIC " & + "SUBTYPE IN THE INSTANCE, THEN EACH USE OF THE " & + "FORMAL PARAMETER IN THE INSTANCE IS SAID TO BE " & + "STATIC. CHECK THAT A NAME DENOTING A CONSTANT " & + "DECLARED IN A GENERIC INSTANCE IS ALLOWED AS " & + "A PRIMARY IN A STATIC EXPRESSION IF THE " & + "CONSTANT IS DECLARED BY A CONSTANT DECLARATION " & + "WITH A STATIC SUBTYPE AND INITIALIZED WITH A " & + "STATIC EXPRESSION. (AI-00505)"); + + LOCAL_BLOCK: + + DECLARE + + TYPE NUMBER IS RANGE 1 .. 10 ; + TYPE COLOR IS (RED, ORANGE, YELLOW, GREEN, BLUE) ; + MIDDLE_COLOR : CONSTANT COLOR := GREEN ; + + ENUMERATED_VALUE : COLOR := COLOR'LAST ; + + GENERIC + + TYPE NUMBER_TYPE IS RANGE <> ; + X : INTEGER ; + TYPE ENUMERATED IS (<>) ; + + FIRST_NUMBER : IN NUMBER_TYPE ; + SECOND_NUMBER : IN NUMBER_TYPE ; + THIRD_NUMBER : IN NUMBER_TYPE ; + FIRST_ENUMERATED : IN ENUMERATED ; + SECOND_ENUMERATED : IN ENUMERATED ; + THIRD_ENUMERATED : IN ENUMERATED ; + + FIRST_INTEGER_VALUE : IN INTEGER ; + SECOND_INTEGER_VALUE : IN INTEGER ; + + PACKAGE STATIC_TEST IS + + Y : CONSTANT INTEGER := X; + Z : CONSTANT NUMBER_TYPE := 5; + + SUBTYPE FIRST_NUMBER_SUBTYPE IS NUMBER_TYPE + RANGE FIRST_NUMBER .. SECOND_NUMBER ; + SUBTYPE SECOND_NUMBER_SUBTYPE IS NUMBER_TYPE + RANGE FIRST_NUMBER .. THIRD_NUMBER ; + + SUBTYPE FIRST_ENUMERATED_SUBTYPE IS ENUMERATED + RANGE FIRST_ENUMERATED .. SECOND_ENUMERATED ; + SUBTYPE SECOND_ENUMERATED_SUBTYPE IS ENUMERATED + RANGE FIRST_ENUMERATED .. THIRD_ENUMERATED ; + + SUBTYPE THIRD_NUMBER_TYPE IS INTEGER + RANGE FIRST_INTEGER_VALUE .. SECOND_INTEGER_VALUE ; + + END STATIC_TEST ; + + PACKAGE NEW_STATIC_TEST IS NEW STATIC_TEST + (NUMBER_TYPE => NUMBER, + X => 3, + ENUMERATED => COLOR, + FIRST_NUMBER => NUMBER'FIRST, + SECOND_NUMBER => NUMBER'LAST, + THIRD_NUMBER => NUMBER'SUCC(NUMBER'FIRST), + FIRST_ENUMERATED => RED, + SECOND_ENUMERATED => MIDDLE_COLOR, + THIRD_ENUMERATED => COLOR'VAL (1), + FIRST_INTEGER_VALUE => COLOR'POS (YELLOW), + SECOND_INTEGER_VALUE => NUMBER'POS (5)) ; + + TYPE T1 IS RANGE 1 .. NEW_STATIC_TEST.Y; + TYPE T2 IS RANGE 1 .. NEW_STATIC_TEST.Z; + + TYPE ANOTHER_NUMBER IS RANGE + NEW_STATIC_TEST.FIRST_NUMBER_SUBTYPE'FIRST .. + NEW_STATIC_TEST.FIRST_NUMBER_SUBTYPE'LAST ; + + TYPE YET_ANOTHER_NUMBER IS RANGE + NEW_STATIC_TEST.SECOND_NUMBER_SUBTYPE'FIRST .. + NEW_STATIC_TEST.SECOND_NUMBER_SUBTYPE'LAST ; + + TYPE STILL_ANOTHER_NUMBER IS RANGE + NEW_STATIC_TEST.THIRD_NUMBER_TYPE'FIRST .. + NEW_STATIC_TEST.THIRD_NUMBER_TYPE'LAST ; + + BEGIN -- LOCAL_BLOCK + + CASE ENUMERATED_VALUE IS + WHEN YELLOW => NULL ; + WHEN NEW_STATIC_TEST.FIRST_ENUMERATED_SUBTYPE'FIRST + => NULL ; + WHEN NEW_STATIC_TEST.FIRST_ENUMERATED_SUBTYPE'LAST + => NULL ; + WHEN NEW_STATIC_TEST.SECOND_ENUMERATED_SUBTYPE'LAST + => NULL ; + WHEN COLOR'LAST => NULL ; + END CASE ; + + END LOCAL_BLOCK ; + + REPORT.RESULT ; + + END A49027B ; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a49027c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a49027c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a49027c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a49027c.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,70 ---- + -- A49027C.ADA + -- + -- 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 IF A GENERIC PARAMETER IS A STATIC EXPRESSION AND THE + -- CORRESPONDING (IN) PARAMETER HAS A STATIC SUBTYPE IN THE INSTANCE, + -- THEN EACH USE OF THE FORMAL PARAMETER IN THE INSTANCE IS SAID TO + -- BE STATIC. + -- + -- SEE AI-00505. THIS TEST IS TAKEN FROM THE SECOND EXAMPLE. + -- + -- HISTORY: + -- DAS 8 OCT 90 INITIAL VERSION. + -- PWN 12/01/95 CORRECTED FORMAT OF CALL TO REPORT.TEST + -- KAS 25NOV96 CHANGED LITERAL 7 TO (IMPDEF.CHAR_BITS-1) + --! + + WITH REPORT; USE REPORT; + WITH IMPDEF; + + PROCEDURE A49027C IS + + GENERIC + X : INTEGER; + PACKAGE GP IS + TYPE REC IS + RECORD + C : STRING (1..X); + END RECORD; + END GP; + + PACKAGE NP IS NEW GP (1); + + TYPE NR IS NEW NP.REC; + FOR NR USE + RECORD + C AT 0 RANGE 0..IMPDEF.CHAR_BITS-1; -- SUBTYPE INDICATION + END RECORD; -- FOR C IN NP IS CONSIDERED STATIC. + + BEGIN + TEST("A49027C", "CHECK THAT IF A GENERIC PARAMETER IS A STATIC " & + "EXPRESSION AND THE CORRESPONDING (IN) PARAMETER HAS A " & + "STATIC SUBTYPE IN THE INSTANCE, THEN EACH USE OF THE " & + "FORMAL PARAMETER IN THE INSTANCE IS SAID TO BE STATIC."); + + RESULT; + + END A49027C; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a54b01a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a54b01a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a54b01a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a54b01a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,119 ---- + -- A54B01A.ADA + + -- 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. + --* + -- CHECK THAT IF A CASE EXPRESSION IS A CONSTANT, VARIABLE, + -- TYPE CONVERSION, OR QUALIFIED EXPRESSION, + -- AND THE SUBTYPE OF THE + -- EXPRESSION IS STATIC, AN 'OTHERS' CAN BE OMITTED IF ALL + -- VALUES IN THE SUBTYPE'S RANGE ARE COVERED. + + + -- RM 01/23/80 + -- SPS 10/26/82 + -- SPS 2/1/83 + + WITH REPORT ; + PROCEDURE A54B01A IS + + USE REPORT ; + + BEGIN + + TEST("A54B01A" , "CHECK THAT IF" & + " THE SUBTYPE OF A CASE EXPRESSION IS STATIC," & + " AN 'OTHERS' CAN BE OMITTED IF ALL" & + " VALUES IN THE SUBTYPE'S RANGE ARE COVERED" ); + + -- THE TEST CASES APPEAR IN THE FOLLOWING ORDER: + -- + -- I. CONSTANTS + -- + -- II. STATIC SUBRANGES + -- + -- (A) VARIABLES (INTEGER , BOOLEAN) + -- (B) QUALIFIED EXPRESSIONS + -- (C) TYPE CONVERSIONS + + DECLARE -- CONSTANTS + T : CONSTANT BOOLEAN := TRUE; + FIVE : CONSTANT INTEGER := IDENT_INT(5); + BEGIN + + CASE FIVE IS + WHEN INTEGER'FIRST..4 => NULL ; + WHEN 5 => NULL ; + WHEN 6 .. INTEGER'LAST => NULL ; + END CASE; + + CASE T IS + WHEN TRUE => NULL ; + WHEN FALSE => NULL ; + END CASE; + + END ; + + + DECLARE -- STATIC SUBRANGES + + SUBTYPE STAT IS INTEGER RANGE 1..5 ; + I : INTEGER RANGE 1..5 ; + J : STAT ; + BOOL: BOOLEAN := FALSE ; + CHAR: CHARACTER := 'U' ; + TYPE ENUMERATION IS ( FIRST,SECOND,THIRD,FOURTH,FIFTH ); + ENUM: ENUMERATION := THIRD ; + + + BEGIN + + I := IDENT_INT( 2 ); + J := IDENT_INT( 2 ); + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + END CASE; + + CASE BOOL IS + WHEN TRUE => NULL ; + WHEN FALSE => NULL ; + END CASE; + + CASE STAT'( 2 ) IS + WHEN 5 | 2..4 => NULL ; + WHEN 1 => NULL ; + END CASE; + + CASE STAT( J ) IS + WHEN 5 | 2..4 => NULL ; + WHEN 1 => NULL ; + END CASE; + + + END ; -- STATIC SUBRANGES + + RESULT ; + + + END A54B01A ; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a54b02a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a54b02a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a54b02a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a54b02a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,184 ---- + -- A54B02A.ADA + + -- 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. + --* + -- CHECK THAT IF A CASE EXPRESSION IS A VARIABLE, CONSTANT, TYPE + -- CONVERSION, ATTRIBUTE (IN PARTICULAR 'FIRST AND 'LAST), + -- FUNCTION INVOCATION, QUALIFIED EXPRESSION, OR A PARENTHESIZED + -- EXPRESSION HAVING ONE OF THESE FORMS, AND THE SUBTYPE OF THE + -- EXPRESSION IS NON-STATIC, AN 'OTHERS' CAN BE OMITTED IF ALL + -- VALUES IN THE BASE TYPE'S RANGE ARE COVERED. + + -- RM 01/27/80 + -- SPS 10/26/82 + -- SPS 2/2/83 + -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X. + + WITH REPORT ; + PROCEDURE A54B02A IS + + USE REPORT ; + + BEGIN + + TEST("A54B02A" , "CHECK THAT IF THE" & + " SUBTYPE OF A CASE EXPRESSION IS NON-STATIC," & + " AN 'OTHERS' CAN BE OMITTED IF ALL" & + " VALUES IN THE BASE TYPE'S RANGE ARE COVERED" ); + + -- THE TEST CASES APPEAR IN THE FOLLOWING ORDER: + -- + -- (A) VARIABLES (INTEGER , BOOLEAN) + -- (B) CONSTANTS (INTEGER, BOOLEAN) + -- (C) ATTRIBUTES ('FIRST, 'LAST) + -- (D) FUNCTION CALLS + -- (E) QUALIFIED EXPRESSIONS + -- (F) TYPE CONVERSIONS + -- (G) PARENTHESIZED EXPRESSIONS OF THE ABOVE KINDS + + + DECLARE -- NON-STATIC RANGES + + SUBTYPE STAT IS INTEGER RANGE 1..50 ; + SUBTYPE DYN IS STAT RANGE 1..IDENT_INT( 5 ) ; + I : STAT RANGE 1..IDENT_INT( 5 ); + J : DYN ; + SUBTYPE DYNCHAR IS + CHARACTER RANGE ASCII.NUL .. IDENT_CHAR('Q'); + SUBTYPE STATCHAR IS + DYNCHAR RANGE 'A' .. 'C' ; + CHAR: DYNCHAR := 'F' ; + TYPE ENUMERATION IS ( A,B,C,D,E,F,G,H,K,L,M,N ); + SUBTYPE STATENUM IS + ENUMERATION RANGE A .. L ; + SUBTYPE DYNENUM IS + STATENUM RANGE A .. ENUMERATION'VAL(IDENT_INT(5)); + ENUM: DYNENUM := B ; + CONS : CONSTANT DYN := 3; + + FUNCTION FF RETURN DYN IS + BEGIN + RETURN 2 ; + END FF ; + + BEGIN + + I := IDENT_INT( 2 ); + J := IDENT_INT( 2 ); + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + END CASE; + + CASE J IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + END CASE; + + CASE CONS IS + WHEN INTEGER'FIRST..INTEGER'LAST => NULL; + END CASE; + + CASE DYN'FIRST IS + WHEN INTEGER'FIRST..0 => NULL; + WHEN 1..INTEGER'LAST => NULL; + END CASE; + + CASE STATCHAR'LAST IS + WHEN CHARACTER'FIRST..'A' => NULL; + WHEN 'B'..CHARACTER'LAST => NULL; + END CASE; + + CASE FF IS + WHEN 4..5 => NULL ; + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + WHEN 1..3 => NULL ; + END CASE; + + CASE DYN'( 2 ) IS + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + WHEN 5 | 2..4 => NULL ; + WHEN 1 => NULL ; + END CASE; + + CASE DYN( J ) IS + WHEN 5 | 2..4 => NULL ; + WHEN 1 => NULL ; + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + END CASE; + + + CASE ( CHAR ) IS + WHEN ASCII.NUL .. 'P' => NULL ; + WHEN 'Q' => NULL ; + WHEN 'R' .. 'Y' => NULL ; + WHEN 'Z' .. CHARACTER'LAST => NULL ; + END CASE; + + CASE ( ENUM ) IS + WHEN A | C | E => NULL ; + WHEN B | D => NULL ; + WHEN F .. L => NULL ; + WHEN M .. N => NULL ; + END CASE; + + CASE ( FF ) IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + END CASE; + + CASE ( DYN'( I ) ) IS + WHEN 4..5 => NULL ; + WHEN 1..3 => NULL ; + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + END CASE; + + CASE ( DYN( 2 ) ) IS + WHEN 5 | 2..4 => NULL ; + WHEN 1 => NULL ; + WHEN INTEGER'FIRST..0 | 6..INTEGER'LAST => NULL ; + END CASE; + + CASE (CONS) IS + WHEN 1..100 => NULL; + WHEN INTEGER'FIRST..0 => NULL; + WHEN 101..INTEGER'LAST => NULL; + END CASE; + + CASE (DYNCHAR'LAST) IS + WHEN 'B'..'Y' => NULL; + WHEN CHARACTER'FIRST..'A' => NULL; + WHEN 'Z'..CHARACTER'LAST => NULL; + END CASE; + + END; + + + RESULT ; + + + END A54B02A ; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a55b12a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a55b12a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a55b12a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a55b12a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,147 ---- + -- A55B12A.ADA + + -- 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. + --* + -- CHECK THAT THE SUBTYPE OF A LOOP PARAMETER IN A LOOP OF THE FORM + -- + -- FOR I IN ST RANGE L..R LOOP + -- + -- IS CORRECTLY DETERMINED SO THAT WHEN THE LOOP PARAMETER IS USED + -- IN A CASE STATEMENT AN 'OTHERS' ALTERNATIVE IS NOT REQUIRED IF + -- THE CHOICES COVER THE APPROPRIATE RANGE OF SUBTYPE VALUES. + + -- CASE A : + -- L AND R ARE BOTH STATIC EXPRESSIONS, AND ST IS A STATIC + -- SUBTYPE COVERING A RANGE GREATER THAN L..R . + + + -- RM 02/02/80 + -- JRK 03/02/83 + + WITH REPORT ; + PROCEDURE A55B12A IS + + USE REPORT ; + + BEGIN + + TEST("A55B12A" , "CHECK THAT THE SUBTYPE OF A LOOP PARAMETER" & + " IN A LOOP OF THE FORM 'FOR I IN ST RANGE" & + " L..R LOOP' IS CORRECTLY DETERMINED (A)" ); + + DECLARE + + SUBTYPE STAT IS INTEGER RANGE 1..10 ; + TYPE NEW_STAT IS NEW INTEGER RANGE 1..10 ; + + TYPE ENUMERATION IS ( A,B,C,D,E,F,G,H,K,L,M,N ); + SUBTYPE STAT_E IS ENUMERATION RANGE A..L ; + SUBTYPE STAT_B IS BOOLEAN RANGE FALSE..TRUE ; + SUBTYPE STAT_C IS CHARACTER RANGE 'A'..'L' ; + + BEGIN + + FOR I IN STAT RANGE 1..5 LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + END CASE; + + END LOOP; + + FOR I IN NEW_STAT RANGE 1..5 LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + END CASE; + + END LOOP; + + FOR I IN INTEGER RANGE 1..5 LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + END CASE; + + END LOOP; + + + FOR I IN REVERSE STAT RANGE 1..5 LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + END CASE; + + END LOOP; + + + FOR I IN STAT_E RANGE A..E LOOP + + CASE I IS + WHEN C..E => NULL ; + WHEN A..B => NULL ; + END CASE; + + END LOOP; + + + FOR I IN STAT_B RANGE TRUE..TRUE LOOP + + CASE I IS + WHEN TRUE => NULL ; + END CASE; + + END LOOP; + + + FOR I IN STAT_C RANGE 'A'..'E' LOOP + + CASE I IS + WHEN 'A'..'C' => NULL ; + WHEN 'D'..'E' => NULL ; + END CASE; + + END LOOP; + + + FOR I IN STAT_C RANGE 'E'..'B' LOOP + + CASE I IS + WHEN 'D'..'C' => NULL ; + WHEN 'E'..'B' => NULL ; + WHEN 'F'..'A' => NULL ; + WHEN 'M'..'A' => NULL ; + END CASE; + + END LOOP; + + + END ; + + RESULT ; + + END A55B12A ; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a55b13a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a55b13a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a55b13a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a55b13a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,128 ---- + -- A55B13A.ADA + + -- 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. + --* + -- USING A CASE_STATEMENT , CHECK THAT IF L , R ARE LITERALS + -- OF TYPE T (INTEGER, BOOLEAN, CHARACTER, USER-DEFINED + -- ENUMERATION TYPE) THE SUBTYPE BOUNDS ASSOCIATED WITH A + -- LOOP OF THE FORM + -- FOR I IN L..R LOOP + -- ARE THE SAME AS THOSE FOR THE CORRESPONDING LOOP OF THE FORM + -- FOR I IN T RANGE L..R LOOP . + + + -- RM 04/07/81 + -- SPS 3/2/83 + -- JBG 8/21/83 + -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X. + + WITH REPORT ; + PROCEDURE A55B13A IS + + USE REPORT ; + + BEGIN + + TEST("A55B13A" , "CHECK THAT THE SUBTYPE OF A LOOP PARAMETER" & + " IN A LOOP OF THE FORM 'FOR I IN " & + " LITERAL_L .. LITERAL_R LOOP' IS CORRECTLY" & + " DETERMINED" ); + + DECLARE + + TYPE ENUMERATION IS ( A,B,C,D,MIDPOINT,E,F,G,H ); + ONE : CONSTANT := 1 ; + FIVE : CONSTANT := 5 ; + + + BEGIN + + + FOR I IN 1..5 LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + END CASE; + + END LOOP; + + + FOR I IN REVERSE ONE .. FIVE LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL ; + WHEN 2 | 4 => NULL ; + END CASE; + + END LOOP; + + + FOR I IN REVERSE FALSE..TRUE LOOP + + CASE I IS + WHEN FALSE => NULL ; + WHEN TRUE => NULL ; + END CASE; + + END LOOP; + + + FOR I IN CHARACTER'('A') .. ASCII.DEL LOOP + + CASE I IS + WHEN CHARACTER'('A')..CHARACTER'('U') => NULL ; + WHEN CHARACTER'('V')..ASCII.DEL => NULL ; + END CASE; + + END LOOP; + + + FOR I IN CHARACTER'('A')..CHARACTER'('H') LOOP + + CASE I IS + WHEN CHARACTER'('A')..CHARACTER'('D') => NULL ; + WHEN CHARACTER'('E')..CHARACTER'('H') => NULL ; + END CASE; + + END LOOP; + + + FOR I IN REVERSE B..H LOOP + + CASE I IS + WHEN B..D => NULL ; + WHEN E..H => NULL ; + WHEN MIDPOINT => NULL ; + END CASE; + + END LOOP; + + + END ; + + + RESULT ; + + + END A55B13A ; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a55b14a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a55b14a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a55b14a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a55b14a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,112 ---- + -- A55B14A.ADA + + -- 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. + --* + -- USING A CASE_STATEMENT , CHECK THAT THE SUBTYPE BOUNDS ASSOCIATED + -- WITH A LOOP OF THE FORM + -- FOR I IN ST LOOP + -- ARE, RESPECTIVELY, ST'FIRST..ST'LAST WHEN ST IS STATIC. + + -- RM 04/07/81 + -- SPS 3/2/83 + -- JBG 3/14/83 + + WITH REPORT; + PROCEDURE A55B14A IS + + USE REPORT; + USE ASCII ; + + TYPE ENUMERATION IS ( A,B,C,D,MIDPOINT,E,F,G,H ); + SUBTYPE ST_I IS INTEGER RANGE 1..5 ; + TYPE NEW_ST_I IS NEW INTEGER RANGE 1..5 ; + SUBTYPE ST_E IS ENUMERATION RANGE B..G ; + SUBTYPE ST_B IS BOOLEAN RANGE FALSE..FALSE; + SUBTYPE ST_C IS CHARACTER RANGE 'A'..DEL ; + + BEGIN + + TEST("A55B14A" , "CHECK THAT THE SUBTYPE OF A LOOP PARAMETER" & + " IN A LOOP OF THE FORM 'FOR I IN ST LOOP'" & + " ARE CORRECTLY DETERMINED WHEN ST IS STATIC" ); + + BEGIN + + + FOR I IN ST_I LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL; + WHEN 2 | 4 => NULL; + END CASE; + + END LOOP; + + + FOR I IN NEW_ST_I LOOP + + CASE I IS + WHEN 1 | 3 | 5 => NULL; + WHEN 2 | 4 => NULL; + END CASE; + + END LOOP; + + + FOR I IN ST_B LOOP + + CASE I IS + WHEN FALSE => NULL; + END CASE; + + END LOOP; + + + FOR I IN ST_C LOOP + + CASE I IS + WHEN 'A'..'U' => NULL; + WHEN 'V'..DEL => NULL; + END CASE; + + END LOOP; + + + FOR I IN ST_E LOOP + + CASE I IS + WHEN B..D => NULL; + WHEN E..G => NULL; + WHEN MIDPOINT => NULL; + END CASE; + + END LOOP; + + + END; + + + RESULT; + + + END A55B14A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a71004a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a71004a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a71004a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a71004a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,130 ---- + -- A71004A.ADA + + -- 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. + --* + -- CHECK THAT ALL FORMS OF DECLARATION PERMITTED IN THE PRIVATE PART OF + -- A PACKAGE ARE INDEED ACCEPTED BY THE COMPILER. + -- TASKS, GENERICS, FIXED AND FLOAT DECLARATIONS ARE NOT TESTED. + + -- DAT 5/6/81 + -- VKG 2/16/83 + + WITH REPORT; USE REPORT; + + PROCEDURE A71004A IS + BEGIN + + TEST ("A71004A", "ALL FORMS OF DECLARATIONS IN PRIVATE PART"); + + DD: + DECLARE + + PACKAGE P1 IS + + TYPE P IS PRIVATE; + TYPE L IS LIMITED PRIVATE; + CP : CONSTANT P; + CL : CONSTANT L; + + PRIVATE + + ONE : CONSTANT := 1; + TWO : CONSTANT := ONE * 1.0 + 1.0; + N1, N2, N3 : CONSTANT := TWO; + TYPE I IS RANGE -10 .. 10; + X4, X5 : CONSTANT I := I(IDENT_INT(3)); + X6, X7 : I := X4 + X5; + TYPE AR IS ARRAY (I) OF L; + + X10 : ARRAY (IDENT_INT(1) .. IDENT_INT (10)) OF I; + X11 : CONSTANT ARRAY (1..10) OF I := (1..10=>3); + TYPE T3 IS (E12); + TYPE T4 IS NEW T3; + + TYPE REC1 (D:BOOLEAN:=TRUE) IS RECORD NULL; END RECORD; + SUBTYPE REC1TRUE IS REC1( D => TRUE ) ; + TYPE L IS NEW REC1TRUE ; + X8 , X9 : AR; + TYPE A6 IS ACCESS REC1 ; + SUBTYPE L1 IS L ; + SUBTYPE A7 IS A6(D=>TRUE); + SUBTYPE I14 IS I RANGE 1 .. 1; + TYPE UA1 IS ARRAY (I14 RANGE <> ) OF I14; + TYPE UA2 IS NEW UA1; + USE STANDARD.ASCII; + + PROCEDURE P1 ; + + FUNCTION F1 (X : UA1) RETURN UA1; + + FUNCTION "+" (X : UA1) RETURN UA1; + + PACKAGE PK IS + PRIVATE + END; + + PACKAGE PK1 IS + PACKAGE PK2 IS END; + PRIVATE + PACKAGE PK3 IS PRIVATE END; + END PK1; + + EX : EXCEPTION; + EX1, EX2 : EXCEPTION; + X99 : I RENAMES X7; + EX3 : EXCEPTION RENAMES EX1; + PACKAGE PQ1 RENAMES DD.P1; + PACKAGE PQ2 RENAMES PK1; + PACKAGE PQ3 RENAMES PQ2 . PK2; + FUNCTION "-" (X : UA1) RETURN UA1 RENAMES "+"; + PROCEDURE P98 RENAMES P1; + TYPE P IS NEW L; + CP : CONSTANT P := (D=> TRUE); + CL : CONSTANT L := L(CP); + + END P1; + + PACKAGE BODY P1 IS + + PROCEDURE P1 IS BEGIN NULL; END P1; + + FUNCTION F1 (X : UA1) RETURN UA1 IS + BEGIN RETURN X; END F1; + + FUNCTION "+" (X : UA1) RETURN UA1 IS + BEGIN RETURN F1(X); END "+"; + + PACKAGE BODY PK1 IS + PACKAGE BODY PK3 IS END; + END PK1; + + BEGIN + NULL ; + END P1; + + BEGIN + NULL; + END DD; + RESULT; + + END A71004A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a73001i.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a73001i.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a73001i.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a73001i.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,73 ---- + -- A73001I.ADA + + -- 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. + --* + -- CHECK THAT IF A SUBPROGRAM IS DECLARED BY A RENAMING DECLARATION OR + -- GENERIC INSTANTIATION IN A PACKAGE SPECIFICATION NO PACKAGE BODY IS + -- REQUIRED. + + -- BHS 6/26/84 + + WITH REPORT; + PROCEDURE A73001I IS + + USE REPORT; + + BEGIN + + TEST ("A73001I", "CHECK THAT NO PACKAGE BODY IS REQUIRED FOR " & + "SUBPROGRAM DECLARED BY RENAMING DECLARATION " & + "OR GENERIC INSTANTIATION IN A PACKAGE " & + "SPECIFICATION"); + + DECLARE + PACKAGE PACK1 IS + FUNCTION ADDI (X,Y : INTEGER) RETURN INTEGER RENAMES "+"; + END PACK1; + + BEGIN + NULL; + END; + + + DECLARE + GENERIC + TYPE ITEM IS RANGE <>; + PROCEDURE P (X : IN OUT ITEM); + + PROCEDURE P (X : IN OUT ITEM) IS + BEGIN + NULL; + END P; + + PACKAGE PACK2 IS + PROCEDURE NADA IS NEW P (INTEGER); + END PACK2; + + BEGIN + NULL; + END; + + RESULT; + + END A73001I; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a73001j.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a73001j.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a73001j.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a73001j.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,78 ---- + -- A73001J.ADA + + -- 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. + --* + -- CHECK THAT IF A SUBPROGRAM IS DECLARED BY A RENAMING DECLARATION OR + -- GENERIC INSTANTIATION IN A GENERIC PACKAGE SPECIFICATION, NO PACKAGE + -- BODY IS REQUIRED. + + + -- BHS 6/27/84 + + WITH REPORT; + PROCEDURE A73001J IS + + USE REPORT; + + BEGIN + + TEST ("A73001J", "CHECK THAT NO PACKAGE BODY IS REQUIRED FOR " & + "SUBPROGRAM DECLARED BY RENAMING DECLARATION " & + "OR GENERIC INSTANTIATION IN A GENERIC " & + "PACKAGE SPECIFICATION"); + + DECLARE + GENERIC + TYPE ITEM IS RANGE <>; + PACKAGE PACK1 IS + FUNCTION ADDI (X,Y : ITEM) RETURN ITEM RENAMES "+"; + END PACK1; + + BEGIN + NULL; + END; + + + DECLARE + GENERIC + TYPE ITEM IS RANGE <>; + PROCEDURE P (X : IN OUT ITEM); + + PROCEDURE P (X : IN OUT ITEM) IS + BEGIN + NULL; + END P; + + GENERIC + TYPE OBJ IS RANGE <>; + PACKAGE PACK2 IS + PROCEDURE NADA IS NEW P (OBJ); + END PACK2; + + BEGIN + NULL; + END; + + RESULT; + + END A73001J; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a74105b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a74105b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a74105b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a74105b.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,78 ---- + -- A74105B.ADA + + -- 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. + --* + -- CHECK THAT THE FULL TYPE DECLARATION OF A PRIVATE TYPE WITHOUT + -- DISCRIMINANTS MAY BE A CONSTRAINED TYPE WITH DISCRIMINANTS. + + -- DSJ 4/29/83 + -- SPS 10/22/83 + + WITH REPORT; + PROCEDURE A74105B IS + + USE REPORT; + + BEGIN + + TEST ("A74105B", "CHECK THAT THE FULL TYPE DECLARATION OF A " & + "PRIVATE TYPE WITHOUT DISCRIMINANTS MAY BE " & + "A CONSTRAINED TYPE WITH DISCRIMINANTS"); + + DECLARE + + TYPE REC1 (D : INTEGER) IS + RECORD + C1, C2 : INTEGER; + END RECORD; + + TYPE REC2 (F : INTEGER := 0) IS + RECORD + E1, E2 : INTEGER; + END RECORD; + + TYPE REC3 IS NEW REC1 (D => 1); + + TYPE REC4 IS NEW REC2 (F => 2); + + PACKAGE PACK1 IS + TYPE P1 IS PRIVATE; + TYPE P2 IS PRIVATE; + TYPE P3 IS PRIVATE; + TYPE P4 IS PRIVATE; + PRIVATE + TYPE P1 IS ACCESS REC1; + TYPE P2 IS NEW REC4; + TYPE P3 IS NEW REC1 (D => 5); + TYPE P4 IS NEW REC2 (F => 7); + END PACK1; + + BEGIN + + NULL; + + END; + + RESULT; + + END A74105B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a74106a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a74106a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a74106a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a74106a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,168 ---- + -- A74106A.ADA + + -- 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. + --* + -- CHECK THAT A FULL DECLARATION FOR A PRIVATE TYPE OR FOR A LIMITED + -- PRIVATE TYPE CAN BE GIVEN IN TERMS OF ANY SCALAR TYPE, ARRAY TYPE, + -- RECORD TYPE (WITH OR WITHOUT DISCRIMINANTS), ACCESS TYPE (WITH + -- OR WITHOUT DISCRIMINANTS), OR ANY TYPE DERIVED FROM ANY OF THE + -- ABOVE. + + -- PART A: TYPES NOT INVOLVING FLOATING-POINT DATA OR FIXED-POINT DATA. + + + -- RM 05/13/81 + + + WITH REPORT; + PROCEDURE A74106A IS + + USE REPORT; + + BEGIN + + TEST( "A74106A" , "CHECK THAT PRIVATE TYPES AND LIMITED PRIVATE " & + "TYPES CAN BE DEFINED IN TERMS OF " & + "VARIOUS OTHER TYPES" ); + + DECLARE + + TYPE ENUM IS ( A , B , C , D ); + + PACKAGE P0 IS + TYPE T0 IS PRIVATE; + PRIVATE + TYPE T0 IS NEW INTEGER; + END P0; + + PACKAGE P1 IS + USE P0; + TYPE T1 IS PRIVATE; + TYPE T2 IS PRIVATE; + TYPE T3 IS PRIVATE; + TYPE T4 IS PRIVATE; + TYPE T5 IS PRIVATE; + TYPE T6 IS PRIVATE; + TYPE T7 IS PRIVATE; + TYPE T8 IS PRIVATE; + TYPE T9 IS PRIVATE; + TYPE TA IS PRIVATE; + TYPE TB IS PRIVATE; + TYPE TC IS PRIVATE; + TYPE TD(I : INTEGER) IS PRIVATE; + TYPE NT IS NEW ENUM; + TYPE ARR_T IS ARRAY(1..2) OF BOOLEAN; + TYPE ACC_T IS ACCESS CHARACTER; + TYPE REC_T IS RECORD T : BOOLEAN; END RECORD; + TYPE D_REC_T(I : INTEGER := 1) IS + RECORD T : ENUM; END RECORD; + PRIVATE + TYPE TY(B : BOOLEAN) IS + RECORD G : BOOLEAN; END RECORD; + TYPE TC IS NEW T0; + TYPE T1 IS RANGE 1..100; + TYPE T2 IS NEW CHARACTER RANGE 'A'..'Z'; + TYPE T3 IS NEW NT; + TYPE T4 IS ARRAY(1..2) OF INTEGER; + TYPE T5 IS NEW ARR_T; + TYPE T6 IS ACCESS ENUM; + TYPE T7 IS NEW ACC_T; + TYPE T8 IS + RECORD T : CHARACTER; END RECORD; + TYPE T9 IS NEW REC_T; + TYPE TA IS ACCESS TD; + TYPE TB IS ACCESS D_REC_T; + TYPE TD(I : INTEGER) IS + RECORD G : BOOLEAN; END RECORD; + + END P1; + + BEGIN + + NULL; + + END; + + + DECLARE + + TYPE ENUM IS ( A , B , C , D ); + + PACKAGE P0 IS + TYPE T0 IS LIMITED PRIVATE; + PRIVATE + TYPE T0 IS NEW ENUM; + END P0; + + PACKAGE P1 IS + USE P0; + TYPE T1 IS LIMITED PRIVATE; + TYPE T2 IS LIMITED PRIVATE; + TYPE T3 IS LIMITED PRIVATE; + TYPE T4 IS LIMITED PRIVATE; + TYPE T5 IS LIMITED PRIVATE; + TYPE T6 IS LIMITED PRIVATE; + TYPE T7 IS LIMITED PRIVATE; + TYPE T8 IS LIMITED PRIVATE; + TYPE T9 IS LIMITED PRIVATE; + TYPE TA IS LIMITED PRIVATE; + TYPE TB IS LIMITED PRIVATE; + TYPE TC IS LIMITED PRIVATE; + TYPE TD(I : INTEGER) IS LIMITED PRIVATE; + TYPE NT IS NEW ENUM; + TYPE ARR_T IS ARRAY(1..2) OF BOOLEAN; + TYPE ACC_T IS ACCESS CHARACTER; + TYPE REC_T IS RECORD T : BOOLEAN; END RECORD; + TYPE D_REC_T(I : INTEGER := 1) IS + RECORD T : ENUM; END RECORD; + PRIVATE + TYPE TY(B : BOOLEAN) IS + RECORD G : BOOLEAN; END RECORD; + TYPE TC IS NEW T0; + TYPE T1 IS RANGE 1..100; + TYPE T2 IS NEW CHARACTER RANGE 'A'..'Z'; + TYPE T3 IS NEW NT; + TYPE T4 IS ARRAY(1..2) OF INTEGER; + TYPE T5 IS NEW ARR_T; + TYPE T6 IS ACCESS ENUM; + TYPE T7 IS NEW ACC_T; + TYPE T8 IS RECORD T : CHARACTER; END RECORD; + TYPE T9 IS NEW REC_T; + TYPE TA IS ACCESS TD; + TYPE TB IS ACCESS D_REC_T; + TYPE TD(I : INTEGER) IS + RECORD G : BOOLEAN; END RECORD; + + END P1; + + BEGIN + + NULL; + + END; + + + RESULT; + + + END A74106A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a74106b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a74106b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a74106b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a74106b.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,159 ---- + -- A74106B.ADA + + -- 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. + --* + -- CHECK THAT A FULL DECLARATION FOR A PRIVATE TYPE OR FOR A LIMITED + -- PRIVATE TYPE CAN BE GIVEN IN TERMS OF ANY SCALAR TYPE, ARRAY TYPE, + -- RECORD TYPE (WITH OR WITHOUT DISCRIMINANTS), ACCESS TYPE (WITH + -- OR WITHOUT DISCRIMINANTS), OR ANY TYPE DERIVED FROM ANY OF THE + -- ABOVE. + + -- PART B: TYPES INVOLVING FLOATING-POINT DATA. + + + -- RM 05/08/81 + + + WITH REPORT; + PROCEDURE A74106B IS + + USE REPORT; + + BEGIN + + TEST( "A74106B" , "CHECK THAT PRIVATE TYPES AND LIMITED PRIVATE " & + "TYPES CAN BE DEFINED IN TERMS OF " & + "FLOATING-POINT TYPES" ); + + DECLARE + + PACKAGE P0 IS + TYPE F0 IS PRIVATE; + PRIVATE + TYPE F0 IS NEW FLOAT; + END P0; + + PACKAGE P1 IS + USE P0; + TYPE F1 IS PRIVATE; + TYPE F2 IS PRIVATE; + TYPE F3 IS PRIVATE; + TYPE F4 IS PRIVATE; + TYPE F5 IS PRIVATE; + TYPE F6 IS PRIVATE; + TYPE F7 IS PRIVATE; + TYPE F8 IS PRIVATE; + TYPE F9 IS PRIVATE; + TYPE FA IS PRIVATE; + TYPE FB IS PRIVATE; + TYPE FC IS PRIVATE; + TYPE FD(I : INTEGER) IS PRIVATE; + TYPE NF IS NEW FLOAT; + TYPE ARR_F IS ARRAY(1..2) OF FLOAT; + TYPE ACC_F IS ACCESS FLOAT; + TYPE REC_F IS RECORD F : FLOAT; END RECORD; + TYPE D_REC_F(I : INTEGER := 1) IS + RECORD F : FLOAT; END RECORD; + PRIVATE + TYPE FY(B : BOOLEAN) IS RECORD G : FLOAT; END RECORD; + TYPE FC IS NEW F0; + TYPE F1 IS DIGITS 3; + TYPE F2 IS NEW FLOAT DIGITS 4; + TYPE F3 IS NEW NF; + TYPE F4 IS ARRAY(1..2) OF FLOAT; + TYPE F5 IS NEW ARR_F; + TYPE F6 IS ACCESS FLOAT; + TYPE F7 IS NEW ACC_F; + TYPE F8 IS RECORD F : FLOAT; END RECORD; + TYPE F9 IS NEW REC_F; + TYPE FA IS ACCESS FD; + TYPE FB IS ACCESS D_REC_F; + TYPE FD(I : INTEGER) IS RECORD G : FLOAT; END RECORD; + + END P1; + + BEGIN + + NULL; + + END; + + + DECLARE + + PACKAGE P0 IS + TYPE F0 IS LIMITED PRIVATE; + PRIVATE + TYPE F0 IS NEW FLOAT; + END P0; + + PACKAGE P1 IS + USE P0; + TYPE F1 IS LIMITED PRIVATE; + TYPE F2 IS LIMITED PRIVATE; + TYPE F3 IS LIMITED PRIVATE; + TYPE F4 IS LIMITED PRIVATE; + TYPE F5 IS LIMITED PRIVATE; + TYPE F6 IS LIMITED PRIVATE; + TYPE F7 IS LIMITED PRIVATE; + TYPE F8 IS LIMITED PRIVATE; + TYPE F9 IS LIMITED PRIVATE; + TYPE FA IS LIMITED PRIVATE; + TYPE FB IS LIMITED PRIVATE; + TYPE FC IS LIMITED PRIVATE; + TYPE FD(I : INTEGER) IS LIMITED PRIVATE; + TYPE NF IS NEW FLOAT; + TYPE ARR_F IS ARRAY(1..2) OF FLOAT; + TYPE ACC_F IS ACCESS FLOAT; + TYPE REC_F IS RECORD F : FLOAT; END RECORD; + TYPE D_REC_F(I : INTEGER := 1) IS + RECORD F : FLOAT; END RECORD; + PRIVATE + TYPE FY(B : BOOLEAN) IS RECORD G : FLOAT; END RECORD; + TYPE FC IS NEW F0; + TYPE F1 IS DIGITS 3; + TYPE F2 IS NEW FLOAT DIGITS 4; + TYPE F3 IS NEW NF; + TYPE F4 IS ARRAY(1..2) OF FLOAT; + TYPE F5 IS NEW ARR_F; + TYPE F6 IS ACCESS FLOAT; + TYPE F7 IS NEW ACC_F; + TYPE F8 IS RECORD F : FLOAT; END RECORD; + TYPE F9 IS NEW REC_F; + TYPE FA IS ACCESS FD; + TYPE FB IS ACCESS D_REC_F; + TYPE FD(I : INTEGER) IS RECORD G : FLOAT; END RECORD; + + END P1; + + BEGIN + + NULL; + + END; + + + RESULT; + + + END A74106B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a74106c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a74106c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a74106c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a74106c.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,155 ---- + -- A74106C.ADA + + -- 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 A FULL DECLARATION FOR A PRIVATE TYPE OR FOR A LIMITED + -- PRIVATE TYPE CAN BE GIVEN IN TERMS OF ANY SCALAR TYPE, ARRAY + -- TYPE, RECORD TYPE (WITH OR WITHOUT DISCRIMINANTS), ACCESS TYPE + -- (WITH OR WITHOUT DISCRIMINANTS), OR ANY TYPE DERIVED FROM ANY + -- OF THE ABOVE. + + -- PART C: TYPES INVOLVING FIXED-POINT DATA. + + -- HISTORY: + -- RM 05/11/81 CREATED ORIGINAL TEST. + -- DHH 10/15/87 CORRECTED RANGE ERRORS. + + + WITH REPORT; + PROCEDURE A74106C IS + + USE REPORT; + + BEGIN + + TEST( "A74106C" , "CHECK THAT PRIVATE TYPES AND LIMITED PRIVATE" & + " TYPES CAN BE DEFINED IN TERMS OF" & + " FIXED-POINT TYPES" ); + + DECLARE + + PACKAGE P0 IS + TYPE F0 IS PRIVATE; + PRIVATE + TYPE F0 IS DELTA 1.0 RANGE 0.0 .. 10.0; + END P0; + + PACKAGE P1 IS + USE P0; + TYPE FX IS DELTA 0.1 RANGE 0.0 .. 1.0; + TYPE F1 IS PRIVATE; + TYPE F2 IS PRIVATE; + TYPE F3 IS PRIVATE; + TYPE F4 IS PRIVATE; + TYPE F5 IS PRIVATE; + TYPE F6 IS PRIVATE; + TYPE F7 IS PRIVATE; + TYPE F8 IS PRIVATE; + TYPE F9 IS PRIVATE; + TYPE FA IS PRIVATE; + TYPE FB IS PRIVATE; + TYPE FC IS PRIVATE; + TYPE NF IS DELTA 0.1 RANGE 1.0 .. 2.0; + TYPE ARR_F IS ARRAY(1..2) OF FX; + TYPE ACC_F IS ACCESS FX; + TYPE REC_F IS RECORD F : FX; END RECORD; + TYPE D_REC_F(I : INTEGER := 1) IS + RECORD F : FX; END RECORD; + PRIVATE + TYPE FC IS NEW F0; + TYPE F1 IS DELTA 100.0 RANGE -100.0 .. 900.0; + TYPE F2 IS NEW FX RANGE 0.0 .. 0.5; + TYPE F3 IS NEW NF; + TYPE F4 IS ARRAY(1..2) OF FX; + TYPE F5 IS NEW ARR_F; + TYPE F6 IS ACCESS FX; + TYPE F7 IS NEW ACC_F; + TYPE F8 IS RECORD F : FX; END RECORD; + TYPE F9 IS NEW REC_F; + TYPE FA IS ACCESS D_REC_F; + TYPE FB IS ACCESS D_REC_F; + END P1; + + BEGIN + + NULL; + + END; + + + DECLARE + + PACKAGE P0 IS + TYPE F0 IS LIMITED PRIVATE; + PRIVATE + TYPE F0 IS DELTA 1.0 RANGE 0.0 .. 10.0; + END P0; + + PACKAGE P1 IS + USE P0; + TYPE FX IS DELTA 0.1 RANGE 0.0 .. 1.0; + TYPE F1 IS LIMITED PRIVATE; + TYPE F2 IS LIMITED PRIVATE; + TYPE F3 IS LIMITED PRIVATE; + TYPE F4 IS LIMITED PRIVATE; + TYPE F5 IS LIMITED PRIVATE; + TYPE F6 IS LIMITED PRIVATE; + TYPE F7 IS LIMITED PRIVATE; + TYPE F8 IS LIMITED PRIVATE; + TYPE F9 IS LIMITED PRIVATE; + TYPE FA IS LIMITED PRIVATE; + TYPE FB IS LIMITED PRIVATE; + TYPE FC IS LIMITED PRIVATE; + TYPE NF IS DELTA 0.1 RANGE 1.0 .. 2.0; + TYPE ARR_F IS ARRAY(1..2) OF FX; + TYPE ACC_F IS ACCESS FX; + TYPE REC_F IS RECORD F : FX; END RECORD; + TYPE D_REC_F(I : INTEGER := 1) IS + RECORD F : FX; END RECORD; + PRIVATE + TYPE FC IS NEW F0; + TYPE F1 IS DELTA 100.0 RANGE -100.0 .. 900.0; + TYPE F2 IS NEW FX RANGE 0.0 .. 0.5; + TYPE F3 IS NEW NF; + TYPE F4 IS ARRAY(1..2) OF FX; + TYPE F5 IS NEW ARR_F; + TYPE F6 IS ACCESS FX; + TYPE F7 IS NEW ACC_F; + TYPE F8 IS RECORD F : FX; END RECORD; + TYPE F9 IS NEW REC_F; + TYPE FA IS ACCESS D_REC_F; + TYPE FB IS ACCESS D_REC_F; + END P1; + + BEGIN + + NULL; + + END; + + + RESULT; + + + END A74106C; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a74205e.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a74205e.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a74205e.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a74205e.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,149 ---- + -- A74205E.ADA + + -- 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. + --* + -- CHECK THAT THE ADDITIONAL OPERATIONS FOR A COMPOSITE TYPE WITH A + -- COMPONENT OF A PRIVATE TYPE ARE AVAILABLE AT THE EARLIEST + -- PLACE WITHIN THE IMMEDIATE SCOPE OF THE DECLARATION OF THE COMPOSITE + -- TYPE AND AFTER THE FULL DECLARATION OF THE PRIVATE TYPE. + + -- IN PARTICULAR, CHECH FOR THE FOLLOWING : + + -- (1) RELATIONAL OPERATORS WITH ARRAYS OF SCALAR TYPES + -- (2) EQUALITY WITH ARRAYS AND RECORDS OF LIMITED PRIVATE TYPES + -- (3) LOGICAL OPERATORS WITH ARRAYS OF BOOLEAN TYPES + -- (4) CATENATION WITH ARRAYS OF LIMITED PRIVATE TYPES + -- (5) INITIALIZATION WITH ARRAYS AND RECORDS OF LIMITED PRIVATE TYPES + -- (6) ASSIGNMENT WITH ARRAYS AND RECORDS OF LIMITED PRIVATE TYPES + -- (7) SELECTED COMPONENTS WITH COMPOSITES OF PRIVATE RECORD TYPES + -- (8) INDEXED COMPONENTS WITH COMPOSITES OF PRIVATE ARRAY TYPES + -- (9) SLICES WITH COMPOSITES OF PRIVATE ARRAY TYPES + -- (10) QUALIFICATION FOR COMPOSITES OF PRIVATE TYPES + -- (11) AGGREGATES FOR ARRAYS AND RECORDS OF PRIVATES TYPES + -- (12) USE OF 'SIZE FOR ARRAYS AND RECORDS OF PRIVATE TYPES + + -- DSJ 5/2/83 + + WITH REPORT ; + PROCEDURE A74205E IS + + USE REPORT ; + + BEGIN + + TEST("A74205E", "CHECK THAT ADDITIONAL OPERATIONS FOR " + & "COMPOSITE TYPES OF PRIVATE TYPES ARE " + & "AVAILABLE AT THE EARLIEST PLACE AFTER THE " + & "FULL DECLARATION AND IN THE IMMEDIATE " + & "SCOPE OF THE COMPOSITE TYPE") ; + + DECLARE + + PACKAGE PACK1 IS + TYPE LP1 IS LIMITED PRIVATE ; + PACKAGE PACK_LP IS + TYPE LP_ARR IS ARRAY (INTEGER RANGE <>) OF LP1 ; + SUBTYPE LP_ARR2 IS LP_ARR ( 1 .. 2 ) ; + SUBTYPE LP_ARR4 IS LP_ARR ( 1 .. 4 ) ; + END PACK_LP ; + + TYPE T1 IS PRIVATE ; + PACKAGE PACK2 IS + TYPE ARR IS ARRAY (INTEGER RANGE <>) OF T1 ; + SUBTYPE ARR2 IS ARR ( 1 .. 2 ) ; + SUBTYPE ARR4 IS ARR ( 1 .. 4 ) ; + END PACK2 ; + + TYPE T2 IS PRIVATE ; + TYPE T3 IS PRIVATE ; + PACKAGE PACK3 IS + TYPE ARR_T2 IS ARRAY ( 1 .. 2 ) OF T2 ; + TYPE ARR_T3 IS ARRAY ( 1 .. 2 ) OF T3 ; + END PACK3 ; + PRIVATE + TYPE LP1 IS NEW BOOLEAN ; + TYPE T1 IS NEW BOOLEAN ; + TYPE T2 IS ARRAY ( 1 .. 2 ) OF INTEGER ; + TYPE T3 IS + RECORD + C1 : INTEGER ; + END RECORD ; + END PACK1 ; + + PACKAGE BODY PACK1 IS + + PACKAGE BODY PACK_LP IS + L1, L2 : LP_ARR2 := (TRUE,FALSE) ; -- LEGAL + A3 : LP_ARR2 := L1 ; -- LEGAL + B3 : BOOLEAN := L1 = L2 ; -- LEGAL + B4 : BOOLEAN := L1 /= L2 ; -- LEGAL + END PACK_LP ; + + PACKAGE BODY PACK2 IS + A1, A2 : ARR2 := (FALSE,TRUE) ; -- LEGAL + A4 : ARR2 := ARR2'(A1) ; -- LEGAL + B1 : BOOLEAN := A1 < A2 ; -- LEGAL + B2 : BOOLEAN := A1 >= A2 ; -- LEGAL + N3 : INTEGER := A1'SIZE ; -- LEGAL + PROCEDURE G1 (X : ARR2 := NOT A1) IS -- LEGAL + BEGIN + NULL ; + END G1 ; + + PROCEDURE G2 (X : ARR2 := A1 AND A2) IS -- LEGAL + BEGIN + NULL ; + END G2 ; + + PROCEDURE G3 (X : ARR4 := A1 & A2) IS -- LEGAL + BEGIN + NULL ; + END G3 ; + + PROCEDURE G4 (X : ARR2 := (FALSE,TRUE) ) IS -- LEGAL + BEGIN + NULL ; + END G4 ; + END PACK2 ; + + PACKAGE BODY PACK3 IS + X2 : ARR_T2 := + (1=>(1,2), 2=>(3,4)) ; -- LEGAL + X3 : ARR_T3 := + (1=>(C1=>5), 2=>(C1=>6)) ; -- LEGAL + N1 : INTEGER := X3(1).C1 ; -- LEGAL + N2 : INTEGER := X2(1)(2) ; -- LEGAL + N4 : T2 := X2(1)(1..2) ; -- LEGAL + END PACK3 ; + + END PACK1 ; + + BEGIN + + NULL ; + + END ; + + RESULT ; + + END A74205E ; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a74205f.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a74205f.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a74205f.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a74205f.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,93 ---- + -- A74205F.ADA + + -- 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. + --* + -- CHECK THAT FOR AN ACCESS TYPE WHOSE DESIGNATED TYPE IS A PRIVATE TYPE + -- ADDITIONAL OPERATIONS FOR THE ACCESS TYPE WHICH DEPEND ON + -- CHARACTERISTICS OF THE FULL DECLARATION OF THE PRIVATE TYPE ARE MADE + -- AVAILABLE AT THE EARLIEST PLACE WITHIN THE IMMEDIATE SCOPE OF THE + -- ACCESS TYPE DECLARATION AND AFTER THE FULL DECLARATION OF THE PRIVATE + -- TYPE. + + -- (1) CHECK FOR COMPONENT SELECTION WITH RECORD TYPES + -- (2) CHECK FOR INDEXED COMPONENTS AND SLICES WITH ARRAY TYPES + -- (3) CHECK FOR USE OF 'FIRST, 'LAST, 'RANGE, AND 'LENGTH WITH ARRAY + -- TYPES + + -- DSJ 5/5/83 + + WITH REPORT ; + PROCEDURE A74205F IS + + USE REPORT ; + + BEGIN + + TEST("A74205F", "CHECK THAT ADDITIONAL OPERATIONS OF ACCESS TYPES " + & "OF PRIVATE TYPES ARE AVAILABLE AT THE EARLIEST " + & "PLACE IN THE IMMEDIATE SCOPE OF THE ACCESS TYPE " + & "AND AFTER THE FULL DECLARATION") ; + + DECLARE + + PACKAGE PACK1 IS + TYPE T1 IS PRIVATE ; + TYPE T2 IS PRIVATE ; + PACKAGE PACK2 IS + TYPE ACC1 IS ACCESS T1 ; + TYPE ACC2 IS ACCESS T2 ; + END PACK2 ; + PRIVATE + TYPE T1 IS ARRAY ( 1 .. 2 ) OF INTEGER ; + TYPE T2 IS + RECORD + C1, C2 : INTEGER ; + END RECORD ; + END PACK1 ; + + PACKAGE BODY PACK1 IS + A1 : PACK2.ACC1 := NEW T1'(2,4) ; -- LEGAL + A2 : PACK2.ACC1 := NEW T1'(6,8) ; -- LEGAL + R1 : PACK2.ACC2 := NEW T2'(3,5) ; -- LEGAL + R2 : PACK2.ACC2 := NEW T2'(7,9) ; -- LEGAL + + PACKAGE BODY PACK2 IS + X1 : INTEGER := A1(1) ; -- LEGAL + X2 : INTEGER := A1'FIRST ; -- LEGAL + X3 : INTEGER := A1'LAST ; -- LEGAL + X4 : INTEGER := A1'LENGTH ; -- LEGAL + B1 : BOOLEAN := 3 IN A1'RANGE ; -- LEGAL + X5 : INTEGER := R1.C1 ; -- LEGAL + END PACK2 ; + + END PACK1 ; + + BEGIN + + NULL ; + + END ; + + RESULT ; + + END A74205F ; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83009a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83009a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83009a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83009a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,198 ---- + -- A83009A.ADA + + -- 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 A DERIVED TYPE DECLARATION AND A GENERIC + -- INSTANTIATION MAY DERIVE TWO OR MORE SUBPROGRAM HOMOGRAPHS. + -- CHECK THE CASES WHERE: + -- 1) THE DERIVED SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF THE + -- SUBSTITUTION OF THE DERIVED TYPE FOR THE PARENT TYPE IN + -- THE IMPLICIT SUBPROGRAM SPECIFICATIONS. + -- 2) THE PARENT TYPE IS DECLARED IN A GENERIC INSTANCE AND + -- THE INSTANCE INCLUDES TWO OR MORE DERIVABLE SUBPROGRAMS + -- THAT ARE HOMOGRAPHS AS A RESULT OF THE ARGUMENTS GIVEN + -- FOR THE GENERIC FORMAL-TYPE PARAMETERS. + -- TEST CASES WHERE THE DERIVED TYPE DECLARATIONS AND GENERIC + -- INSTANTIATIONS ARE GIVEN IN: + -- . THE VISIBLE PART OF A PACKAGE SPECIFICATION, + -- . THE PRIVATE PART OF A PACKAGE SPECIFICATION, + -- . A PACKAGE BODY, + -- . A SUBPROGRAM BODY, + -- . A BLOCK STATEMENT. + -- + -- HISTORY: + -- VCL 03-08-88 CREATED ORIGINAL TEST. + + WITH REPORT; USE REPORT; + PROCEDURE A83009A IS + TYPE ENUM IS (E1, E2, E3); + + GENERIC + TYPE T1 IS (<>); + TYPE T2 IS (<>); + PACKAGE G_PACK IS + TYPE PARENT IS (E1, E2, E3); + + PROCEDURE HP (P1 : PARENT; P2 : T1); + PROCEDURE HP (P3 : PARENT; P4 : T2); + + FUNCTION HF (P1 : T1) RETURN PARENT; + FUNCTION HF (P2 : T2) RETURN PARENT; + END G_PACK; + + PACKAGE BODY G_PACK IS + PROCEDURE HP (P1 : PARENT; P2 : T1) IS + BEGIN + NULL; + END HP; + + PROCEDURE HP (P3 : PARENT; P4 : T2) IS + BEGIN + NULL; + END HP; + + FUNCTION HF (P1 : T1) RETURN PARENT IS + BEGIN + RETURN E1; + END HF; + + FUNCTION HF (P2 : T2) RETURN PARENT IS + BEGIN + RETURN E2; + END HF; + END G_PACK; + BEGIN + TEST ("A83009A", "A DERIVED TYPE DECLARATION AND A GENERIC " & + "INSTANTIATION MAY DERIVE TWO OR " & + "MORE SUBPROGRAM HOMOGRAPHS"); + + DECLARE + -- SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF SUBSTITUTION. + + PACKAGE PACK2 IS + TYPE CHILD1 IS PRIVATE; + + PACKAGE IN_PACK2 IS + TYPE PARENT IS (E1, E2, E3); + PROCEDURE HP (P1 : PARENT; P2 : CHILD1); + PROCEDURE HP (P3 : CHILD1; P4 : PARENT); + + FUNCTION HF (P1 : CHILD1; P2 : PARENT) + RETURN PARENT; + FUNCTION HF (P3 : PARENT; P4 : CHILD1) + RETURN PARENT; + END IN_PACK2; + PRIVATE + TYPE CHILD1 IS NEW IN_PACK2.PARENT; + END PACK2; + + PACKAGE BODY PACK2 IS + TYPE CHILD2 IS NEW CHILD1; + + PACKAGE IN_BODY IS + TYPE CHILD3 IS NEW CHILD1; + END IN_BODY; + + PROCEDURE P IS + TYPE CHILD4 IS NEW CHILD1; + BEGIN + NULL; + END; + + PACKAGE BODY IN_PACK2 IS + PROCEDURE HP (P1 : PARENT; P2 : CHILD1) IS + BEGIN + NULL; + END HP; + + PROCEDURE HP (P3 : CHILD1; P4 : PARENT) IS + BEGIN + NULL; + END HP; + + FUNCTION HF (P1 : CHILD1; P2 : PARENT) + RETURN PARENT IS + BEGIN + RETURN E1; + END HF; + + FUNCTION HF (P3 : PARENT; P4 : CHILD1) + RETURN PARENT IS + BEGIN + RETURN E2; + END HF; + END IN_PACK2; + BEGIN + DECLARE + TYPE CHILD5 IS NEW CHILD1; + BEGIN + NULL; + END; + END PACK2; + BEGIN + NULL; + END; + + DECLARE + -- PARENT TYPE IN GENERIC INSTANCE HAS DERIVABLE HOMOGRAPHS. + + PACKAGE INSTANCE1 IS + NEW G_PACK (BOOLEAN, BOOLEAN); + + TYPE CHILD1 IS NEW INSTANCE1.PARENT; + + PACKAGE PACK1 IS + PACKAGE INSTANCE2 IS + NEW G_PACK (CHARACTER, CHARACTER); + + TYPE CHILD2 IS NEW INSTANCE2.PARENT; + TYPE CHILD3 IS PRIVATE; + PRIVATE + PACKAGE INSTANCE3 IS + NEW G_PACK (ENUM, ENUM); + + TYPE CHILD3 IS NEW INSTANCE3.PARENT; + END PACK1; + + PROCEDURE P1 IS + PACKAGE INSTANCE4 IS + NEW G_PACK (BOOLEAN, BOOLEAN); + + TYPE CHILD4 IS NEW INSTANCE4.PARENT; + BEGIN + NULL; + END P1; + + PACKAGE BODY PACK1 IS + PACKAGE INSTANCE5 IS + NEW G_PACK (ENUM, ENUM); + + TYPE CHILD5 IS NEW INSTANCE5.PARENT; + END PACK1; + BEGIN + NULL; + END; + + RESULT; + END A83009A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83009b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83009b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83009b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83009b.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,196 ---- + -- A83009B.ADA + + -- 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 A DERIVED TYPE DECLARATION IN A GENERIC + -- UNIT MAY DERIVE TWO OR MORE SUBPROGRAM HOMOGRAPHS. + -- CHECK THE CASES WHERE: + -- 1) THE DERIVED SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF THE + -- SUBSTITUTION OF THE DERIVED TYPE FOR THE PARENT TYPE IN + -- THE IMPLICIT SUBPROGRAM SPECIFICATIONS. + -- 2) THE PARENT TYPE IS DECLARED IN A GENERIC INSTANCE AND + -- THE INSTANCE INCLUDES TWO OR MORE DERIVABLE SUBPROGRAMS + -- THAT ARE HOMOGRAPHS AS A RESULT OF THE ARGUMENTS GIVEN + -- FOR THE GENERIC FORMAL-TYPE PARAMETERS. + -- TEST CASES WHERE THE DERIVED TYPE DECLARATIONS ARE GIVEN IN: + -- . THE VISIBLE PART OF A GENERIC PACKAGE SPECIFICATION, + -- . THE PRIVATE PART OF A GENERIC PACKAGE SPECIFICATION, + -- . A GENERIC PACKAGE BODY, + -- . A GENERIC SUBPROGRAM BODY. + -- + -- HISTORY: + -- DHH 09/20/88 CREATED ORIGINAL TEST. + + WITH REPORT; USE REPORT; + PROCEDURE A83009B IS + TYPE ENUM IS (E1, E2, E3); + + GENERIC + TYPE T1 IS (<>); + TYPE T2 IS (<>); + PACKAGE G_PACK IS + TYPE PARENT IS (E1, E2, E3); + + PROCEDURE HP (P1 : PARENT; P2 : T1); + PROCEDURE HP (P3 : PARENT; P4 : T2); + + FUNCTION HF (P1 : T1) RETURN PARENT; + FUNCTION HF (P2 : T2) RETURN PARENT; + END G_PACK; + + PACKAGE BODY G_PACK IS + PROCEDURE HP (P1 : PARENT; P2 : T1) IS + BEGIN + NULL; + END HP; + + PROCEDURE HP (P3 : PARENT; P4 : T2) IS + BEGIN + NULL; + END HP; + + FUNCTION HF (P1 : T1) RETURN PARENT IS + BEGIN + RETURN E1; + END HF; + + FUNCTION HF (P2 : T2) RETURN PARENT IS + BEGIN + RETURN E2; + END HF; + END G_PACK; + BEGIN + TEST ("A83009B", "A DERIVED TYPE DECLARATION IN A GENERIC " & + "UNIT MAY DERIVE TWO OR MORE SUBPROGRAM " & + "HOMOGRAPHS"); + + DECLARE + -- SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF SUBSTITUTION. + + GENERIC + PACKAGE PACK2 IS + TYPE CHILD1 IS PRIVATE; + + PACKAGE IN_PACK2 IS + TYPE PARENT IS (E1, E2, E3); + PROCEDURE HP (P1 : PARENT; P2 : CHILD1); + PROCEDURE HP (P3 : CHILD1; P4 : PARENT); + + FUNCTION HF (P1 : CHILD1; P2 : PARENT) + RETURN PARENT; + FUNCTION HF (P3 : PARENT; P4 : CHILD1) + RETURN PARENT; + END IN_PACK2; + + USE IN_PACK2; + PRIVATE + TYPE CHILD1 IS NEW IN_PACK2.PARENT; -- PRIVATE PART + END PACK2; -- OF SPEC. + + PACKAGE BODY PACK2 IS + TYPE CHILD2 IS NEW CHILD1; -- VISIBLE PART OF BODY. + + GENERIC + PACKAGE IN_BODY IS + TYPE CHILD3 IS NEW CHILD1; -- VISIBLE PART OF SPEC. + END IN_BODY; + + GENERIC + PROCEDURE P; + PROCEDURE P IS + TYPE CHILD4 IS NEW CHILD1; -- SUBPROGRAM BODY. + BEGIN + NULL; + END; + + PACKAGE BODY IN_PACK2 IS + PROCEDURE HP (P1 : PARENT; P2 : CHILD1) IS + BEGIN + NULL; + END HP; + + PROCEDURE HP (P3 : CHILD1; P4 : PARENT) IS + BEGIN + NULL; + END HP; + + FUNCTION HF (P1 : CHILD1; P2 : PARENT) + RETURN PARENT IS + BEGIN + RETURN E1; + END HF; + + FUNCTION HF (P3 : PARENT; P4 : CHILD1) + RETURN PARENT IS + BEGIN + RETURN E2; + END HF; + END IN_PACK2; + BEGIN + NULL; + END PACK2; + BEGIN + NULL; + END; + + DECLARE + -- PARENT TYPE IN GENERIC INSTANCE HAS DERIVABLE HOMOGRAPHS. + + GENERIC + PACKAGE PACK1 IS + PACKAGE INSTANCE2 IS + NEW G_PACK (CHARACTER, CHARACTER); + + TYPE CHILD2 IS NEW INSTANCE2.PARENT; + TYPE CHILD3 IS PRIVATE; + PRIVATE + PACKAGE INSTANCE3 IS + NEW G_PACK (ENUM, ENUM); + + TYPE CHILD3 IS NEW INSTANCE3.PARENT; + END PACK1; + + GENERIC + PROCEDURE P1; + PROCEDURE P1 IS + PACKAGE INSTANCE4 IS + NEW G_PACK (BOOLEAN, BOOLEAN); + + TYPE CHILD4 IS NEW INSTANCE4.PARENT; + BEGIN + NULL; + END P1; + + PACKAGE BODY PACK1 IS + PACKAGE INSTANCE5 IS + NEW G_PACK (ENUM, ENUM); + + TYPE CHILD5 IS NEW INSTANCE5.PARENT; + END PACK1; + BEGIN + NULL; + END; + + RESULT; + END A83009B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83a02a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83a02a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83a02a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83a02a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,120 ---- + -- A83A02A.ADA + + -- 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. + --* + -- CHECK THAT A LABEL IN A NESTED SUBPROGRAM OR PACKAGE CAN BE IDENTICAL + -- TO A LABEL OUTSIDE SUCH CONSTRUCT. + + + -- "INSIDE LABEL": INSIDE * PACKAGE _PACK A + -- * FUNCTION INSIDE PACKAGE _PACKFUN B + -- * PROCEDURE _PROC C + -- * PROCEDURE INSIDE BLOCK _BLOCKPROC D + + -- "OUTSIDE LABEL": INSIDE * MAIN _MAIN 1 + -- * BLOCK IN MAIN _BLOCK 2 + -- * LOOP IN BLOCK IN MAIN _BLOCKLOOP 3 + -- * LOOP IN MAIN _LOOP 4 + + -- CASES TESTED: A1 B2 A3 B4 1 2 3 4 + -- D1 C2 C3 D4 + -- D2 AB A X . X . + -- B . X . X + -- C . X X . + -- D X . . X + + + -- RM 02/09/80 + + + WITH REPORT ; + PROCEDURE A83A02A IS + + USE REPORT ; + + PROCEDURE PROC1 IS + BEGIN + << LAB_PROC_BLOCK >> NULL ; -- C2 C + << LAB_PROC_BLOCKLOOP >> NULL ; -- C3 + END PROC1 ; + + PACKAGE PACK1 IS + FUNCTION F RETURN INTEGER ; + END PACK1 ; + + PACKAGE BODY PACK1 IS + FUNCTION F RETURN INTEGER IS + BEGIN + << LAB_PACKFUN_BLOCK >> NULL ; -- B2 B + << LAB_PACKFUN_LOOP >> NULL ; -- B4 + << LAB_PACKFUN_PACK >> NULL ; -- BA (AB) + RETURN 7 ; + END F ; + BEGIN + << LAB_PACK_MAIN >> NULL ; -- A1 A + << LAB_PACK_BLOCKLOOP >> NULL ; -- A3 + << LAB_PACKFUN_PACK >> NULL ; -- BA (AB) + END PACK1 ; + + BEGIN + + TEST( "A83A02A" , "CHECK THAT A LABEL IN A NESTED SUBPROGRAM" & + " OR PACKAGE CAN BE IDENTICAL TO A LABEL" & + " OUTSIDE SUCH CONSTRUCT" ); + + << LAB_PACK_MAIN >> NULL ; -- A1 1 + << LAB_BLOCKPROC_MAIN >> NULL ; -- D1 + + + DECLARE -- + + PROCEDURE PROC2 IS + BEGIN + << LAB_BLOCKPROC_MAIN >> NULL ; -- D1 D + << LAB_BLOCKPROC_LOOP >> NULL ; -- D4 + << LAB_BLOCKPROC_BLOCK >> NULL ; -- D2 + END PROC2 ; + + BEGIN + + << LAB_PACKFUN_BLOCK >> NULL ; -- B2 2 + << LAB_PROC_BLOCK >> NULL ; -- C2 + << LAB_BLOCKPROC_BLOCK >> NULL ; -- D2 + + FOR I IN 1..2 LOOP + << LAB_PACK_BLOCKLOOP >> NULL ; -- A3 3 + << LAB_PROC_BLOCKLOOP >> NULL ; -- C3 + END LOOP; + + END ; + + FOR I IN 1..2 LOOP + << LAB_PACKFUN_LOOP >> NULL ; -- B4 4 + << LAB_BLOCKPROC_LOOP >> NULL ; -- D4 + END LOOP; + + + RESULT ; + + + END A83A02A ; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83a02b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83a02b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83a02b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83a02b.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,116 ---- + -- A83A02B.ADA + + -- 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. + --* + -- CHECK THAT A LABEL IN A NESTED TASK CAN BE IDENTICAL TO A LABEL + -- OUTSIDE THE TASK. + + + -- "INSIDE LABEL": INSIDE * TASK BODY _TASK A + -- * BLOCK IN TASK BODY _TASKBLOCK B + -- * LOOP IN BLOCK IN TASK BODY _TASKBLOCKLOOP + -- * ACCEPT ST. WITHIN TASK BDY _TASKACCEPT D + + -- "OUTSIDE LABEL": INSIDE * MAIN _MAIN 1 + -- * BLOCK IN MAIN _BLOCK 2 + -- * LOOP IN BLOCK IN MAIN _BLOCKLOOP 3 + -- * LOOP IN MAIN _LOOP 4 + + -- CASES TESTED: A1 B2 A3 B4 | 1 2 3 4 + -- D1 C2 C3 D4 ---+---------- + -- A | X . X . + -- B | . X . X + -- C | . X X . + -- D | X . . X + + + -- RM 02/10/80 + + + WITH REPORT ; + PROCEDURE A83A02B IS + + USE REPORT ; + + TASK TYPE TASK1 IS + ENTRY E1 ; + END TASK1 ; + + TASK BODY TASK1 IS + BEGIN + + << LAB_TASK_MAIN >> NULL ; -- A1 A + << LAB_TASK_BLOCKLOOP >> NULL ; -- A3 + + BEGIN + + << LAB_TASKBLOCK_BLOCK >> NULL ; -- B2 B + << LAB_TASKBLOCK_LOOP >> NULL ; -- B4 + + FOR I IN 1..2 LOOP + << LAB_TASKBLOCKLOOP_BLOCK >>NULL ; -- C2 C + << LAB_TASKBLOCKLOOP_BLOCKLOOP >> + NULL ; -- C3 + END LOOP; + + END ; + + ACCEPT E1 DO + << LAB_TASKACCEPT_MAIN >> NULL ; -- D1 D + << LAB_TASKACCEPT_LOOP >> NULL ; -- D4 + END E1 ; + + END TASK1 ; + + BEGIN + + TEST( "A83A02B" , "CHECK THAT A LABEL IN A NESTED TASK" & + " CAN BE IDENTICAL TO A LABEL" & + " OUTSIDE THE TASK" ); + + << LAB_TASK_MAIN >> NULL ; -- A1 1 + << LAB_TASKACCEPT_MAIN >> NULL ; -- D1 + + + BEGIN + + << LAB_TASKBLOCK_BLOCK >> NULL ; -- B2 2 + << LAB_TASKBLOCKLOOP_BLOCK >> NULL ; -- C2 + + FOR I IN 1..2 LOOP + << LAB_TASK_BLOCKLOOP >> NULL ; -- A3 3 + << LAB_TASKBLOCKLOOP_BLOCKLOOP >> NULL ; -- C3 + END LOOP; + + END ; + + FOR I IN 1..2 LOOP + << LAB_TASKBLOCK_LOOP >> NULL ; -- B4 4 + << LAB_TASKACCEPT_LOOP >> NULL ; -- D4 + END LOOP; + + + RESULT ; + + + END A83A02B ; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83a06a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83a06a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83a06a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83a06a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,94 ---- + -- A83A06A.ADA + + -- 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. + --* + -- CHECK THAT A STATEMENT LABEL INSIDE A BLOCK BODY CAN BE THE + -- SAME AS A VARIABLE, CONSTANT, NAMED LITERAL, SUBPROGRAM, + -- ENUMERATION LITERAL, TYPE, OR PACKAGE DECLARED IN THE + -- ENCLOSING BODY. + + + -- RM 02/12/80 + -- JBG 5/16/83 + -- JBG 8/21/83 + -- JRK 12/19/83 + + WITH REPORT; USE REPORT; + PROCEDURE A83A06A IS + + LAB_VAR : INTEGER; + LAB_CONST : CONSTANT INTEGER := 12; + LAB_NAMEDLITERAL : CONSTANT := 13; + TYPE ENUM IS ( AA , BB , LAB_ENUMERAL ); + TYPE LAB_TYPE IS NEW INTEGER; + + PROCEDURE LAB_PROCEDURE IS + BEGIN + NULL; + END LAB_PROCEDURE; + + FUNCTION LAB_FUNCTION RETURN INTEGER IS + BEGIN + RETURN 7; + END LAB_FUNCTION; + + PACKAGE LAB_PACKAGE IS + INT : INTEGER; + END LAB_PACKAGE; + + BEGIN + + TEST ("A83A06A", "CHECK THAT STATEMENT LABELS INSIDE A BLOCK " & + "BODY CAN BE THE SAME AS IDENTIFIERS DECLARED "& + "OUTSIDE THE BODY"); + + LAB_BLOCK_1 : BEGIN NULL; END LAB_BLOCK_1; + + LAB_LOOP_1 : LOOP EXIT; END LOOP LAB_LOOP_1; + + BEGIN + + << LAB_VAR >> -- OK. + BEGIN NULL; END; + << LAB_ENUMERAL >> NULL; -- OK. + + << LAB_PROCEDURE >> -- OK. + FOR I IN INTEGER LOOP + << LAB_CONST >> NULL; -- OK. + << LAB_TYPE >> NULL; -- OK. + << LAB_FUNCTION >> EXIT; -- OK. + END LOOP; + + << LAB_NAMEDLITERAL >> NULL; + << LAB_PACKAGE >> NULL; + END; + + LAB_BLOCK_2 : -- OK. + BEGIN NULL; END LAB_BLOCK_2; + + LAB_LOOP_2 : -- OK. + LOOP EXIT; END LOOP LAB_LOOP_2; + + RESULT; + + END A83A06A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83a08a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83a08a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83a08a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83a08a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,102 ---- + -- A83A08A.ADA + + -- 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: + -- A STATEMENT LABEL DECLARED OUTSIDE A BLOCK CAN HAVE THE SAME + -- IDENTIFIER AS AN ENTITY DECLARED IN THE BLOCK, AND A GOTO + -- STATEMENT USING THE LABEL IS LEGAL OUTSIDE THE BLOCK. + + -- HISTORY: + -- PMW 09/20/88 CREATED ORIGINAL TEST. + + WITH REPORT; USE REPORT; + WITH SYSTEM; + + PROCEDURE A83A08A IS + + PASSES : INTEGER := 0; + + BEGIN + TEST ("A83A08A", "A STATEMENT LABEL DECLARED OUTSIDE A BLOCK " & + "CAN HAVE THE SAME IDENTIFIER AS AN ENTITY " & + "DECLARED IN THE BLOCK, AND A GOTO STATEMENT " & + "USING THE LABEL IS LEGAL OUTSIDE THE BLOCK"); + + GOTO LBLS; + + <> + + DECLARE + LBL : INTEGER := 1; + BEGIN + LBL := IDENT_INT (LBL); + PASSES := PASSES + 1; + END; + + <> + + BEGIN + DECLARE + TYPE STUFF IS (LBL, LBL_ONE, LBL_TWO); + ITEM : STUFF := LBL; + + FUNCTION LBLS (ITEM : STUFF) RETURN BOOLEAN IS + BEGIN + <> + CASE ITEM IS + WHEN LBL => RETURN TRUE; + WHEN LBL_ONE => PASSES := PASSES + 1; + WHEN LBL_TWO => RETURN FALSE; + END CASE; + IF PASSES < 2 THEN + PASSES := PASSES + 1; + GOTO LBL_2; + ELSE + RETURN TRUE; + END IF; + END LBLS; + + BEGIN + CASE PASSES IS + WHEN 0 => ITEM := LBL; + WHEN 1 => ITEM := LBL_ONE; + WHEN OTHERS => ITEM := LBL_TWO; + END CASE; + IF NOT LBLS (ITEM) THEN + COMMENT ("IRRELEVANT"); + END IF; + END; + END; + + + IF PASSES > 1 THEN + GOTO ENOUGH; + END IF; + GOTO LBL; + + <> + + RESULT; + + END A83A08A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83c01c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83c01c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83c01c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83c01c.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,83 ---- + -- A83C01C.ADA + + -- 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. + --* + -- CHECK THAT COMPONENT NAMES MAY BE THE SAME AS NAMES OF + -- FORMAL PARAMETERS, LABELS, LOOP PARAMETERS, + -- VARIABLES, CONSTANTS, SUBPROGRAMS, PACKAGES, TYPES. + -- (NAMES OF COMPONENTS IN LOGICALLY NESTED RECORDS ARE TESTED IN + -- C83C01B.ADA .) + -- (NAMES OF TASKS ARE TESTED IN A83C01T.ADA .) + + -- RM 24 JUNE 1980 + -- JRK 10 NOV 1980 + -- RM 01 JAN 1982 + + WITH REPORT; + PROCEDURE A83C01C IS + + USE REPORT; + + BEGIN + + TEST( "A83C01C" , "CHECK THAT COMPONENT NAMES MAY BE THE SAME AS" & + " NAMES OF VARIABLES AND CONSTANTS " ) ; + + + + DECLARE + + VAR1 , VAR2 : INTEGER := 27 ; + CONST1 : CONSTANT INTEGER := 13 ; + CONST2 : CONSTANT BOOLEAN := FALSE ; + + TYPE R1A IS + RECORD + VAR1,VAR2,CONST1:INTEGER ; + END RECORD ; + + TYPE R1 IS + RECORD + VAR1 : INTEGER ; + VAR2 : BOOLEAN ; + CONST1 : BOOLEAN ; + A : R1A ; + END RECORD ; + + A : R1 := ( VAR1 => VAR1 , A => ( VAR1 => VAR2 , + VAR2 => VAR2 , + CONST1 => VAR1 ) , + VAR2 => CONST2 , CONST1 => CONST2 ) ; + + BEGIN + + VAR1 := A.A.VAR2 ; + A.CONST1 := CONST2 ; + A.A.CONST1 := A.VAR1 + VAR2 ; + + END ; + + + RESULT; + + END A83C01C; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83c01h.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83c01h.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83c01h.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83c01h.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,99 ---- + -- A83C01H.ADA + + -- 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. + --* + -- CHECK THAT COMPONENT NAMES MAY BE THE SAME AS NAMES OF + -- LABELS. + + -- RM 24 JUNE 1980 + -- JRK 10 NOV 1980 + -- RM 01 JAN 1982 + + + WITH REPORT; + PROCEDURE A83C01H IS + + USE REPORT; + + BEGIN + + TEST( "A83C01H" , "CHECK THAT COMPONENT NAMES MAY BE THE SAME AS" & + " NAMES OF LABELS" ) ; + + + -- TEST FOR LABELS + + DECLARE + + TYPE R1A IS + RECORD + LAB3 : INTEGER ; + END RECORD ; + + TYPE R1 IS + RECORD + LAB1 : INTEGER ; + LAB2 : R1A ; + END RECORD ; + + A1 : R1 := ( 1 , ( LAB3 => 5 ) ); + + BEGIN + + << LAB1 >> + << LAB2 >> + << LAB3 >> + + A1.LAB1 := A1.LAB2.LAB3 ; + + DECLARE + + TYPE R1A IS + RECORD + LAB3 : INTEGER ; + LAB4 : INTEGER ; + END RECORD ; + + TYPE R1 IS + RECORD + LAB1 : INTEGER ; + LAB2 : R1A ; + END RECORD ; + + A1 : R1 := ( 3 , ( 6 , 7 ) ); + + BEGIN + + << LAB4 >> + + A1.LAB1 := A1.LAB2.LAB3 + A1.LAB2.LAB4 ; + + END ; + + END ; + + + + RESULT; + + END A83C01H; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83c01i.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83c01i.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a83c01i.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a83c01i.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,112 ---- + -- A83C01I.ADA + + -- 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. + --* + -- CHECK THAT COMPONENT NAMES MAY BE THE SAME AS NAMES OF + -- LOOP PARAMETERS. + + -- RM 24 JUNE 1980 + -- JRK 10 NOV 1980 + -- RM 01 JAN 1982 + + + WITH REPORT; + PROCEDURE A83C01I IS + + USE REPORT; + + BEGIN + + TEST( "A83C01I" , "CHECK THAT COMPONENT NAMES MAY BE THE SAME AS" & + " NAMES OF LOOP PARAMETERS" ) ; + + + + -- TEST FOR LOOP PARAMETERS + + + DECLARE + + TYPE R1A IS + RECORD + LOOP3 : INTEGER ; + END RECORD ; + + TYPE R1 IS + RECORD + LOOP1 : INTEGER ; + LOOP2 : R1A ; + END RECORD ; + + A1 : R1 := ( 3 , ( LOOP3 => 7 ) ); + + BEGIN + + FOR LOOP1 IN 0..1 LOOP + + FOR LOOP2 IN 0..2 LOOP + + FOR LOOP3 IN 0..3 LOOP + + A1.LOOP1 := A1.LOOP2.LOOP3 ; + + DECLARE + + TYPE R1A IS + RECORD + LOOP3 : INTEGER ; + LOOP4 : INTEGER ; + END RECORD ; + + TYPE R1 IS + RECORD + LOOP1 : INTEGER ; + LOOP2 : R1A ; + END RECORD ; + + A1 : R1 := ( 3 , ( 6 , 7 ) ); + + BEGIN + + FOR LOOP4 IN 0..4 LOOP + + A1.LOOP1 := A1.LOOP2.LOOP3 + + A1.LOOP2.LOOP4 ; + + END LOOP ; + + END ; + + END LOOP ; + + END LOOP ; + + END LOOP ; + + END ; + + + + RESULT; + + END A83C01I; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a85007d.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a85007d.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a85007d.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a85007d.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,156 ---- + -- A85007D.ADA + + -- 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. + --* + -- CHECK THAT 'FIRST, 'LAST, 'LENGTH, 'RANGE, 'ADDRESS, 'CONSTRAINED, + -- AND 'SIZE CAN BE APPLIED TO RENAMED NON-ACCESS OUT FORMAL PARAMETERS + -- AND RENAMED COMPONENTS OF NON-ACCESS OUT PARAMETERS. + + -- SPS 02/21/84 (SEE A62006D-B.ADA) + -- EG 02/22/84 + -- EG 05/30/84 + -- JBG 12/2/84 + + WITH REPORT; USE REPORT; + WITH SYSTEM; + + PROCEDURE A85007D IS + + PROCEDURE Q (X : SYSTEM.ADDRESS) IS + BEGIN + NULL; + END Q; + + BEGIN + + TEST ("A85007D", "CHECK THAT ATTRIBUTES MAY BE APPLIED TO " & + "RENAMED NON-ACCESS FORMAL OUT PARAMETERS"); + + DECLARE + + TYPE ARR IS ARRAY (1 .. 2) OF BOOLEAN; + TYPE REC (D : INTEGER) IS RECORD + Y : BOOLEAN; + X : ARR; + END RECORD; + + PROCEDURE PROC (C2 : OUT ARR; + C3 : OUT REC) IS + + X : SYSTEM.ADDRESS; + I : INTEGER; + + C21 : ARR RENAMES C2; + C22 : ARR RENAMES C21; + C31 : REC RENAMES C3; + C32 : REC RENAMES C31; + C33 : ARR RENAMES C3.X; + C34 : ARR RENAMES C33; + C35 : ARR RENAMES C32.X; + C36 : BOOLEAN RENAMES C3.Y; + C37 : BOOLEAN RENAMES C36; + C38 : BOOLEAN RENAMES C32.Y; + + BEGIN + + I := C21'LENGTH; + Q(C21'ADDRESS); + I := C21'SIZE; + I := C22'LENGTH; + Q(C22'ADDRESS); + I := C22'SIZE; + + FOR I IN C21'RANGE LOOP + NULL; + END LOOP; + FOR I IN C22'RANGE LOOP + NULL; + END LOOP; + + FOR I IN C21'FIRST..C21'LAST LOOP + NULL; + END LOOP; + FOR I IN C22'FIRST..C22'LAST LOOP + NULL; + END LOOP; + + I := C31.X'LENGTH; + C3.Y := C31'CONSTRAINED; + FOR J IN C31.X'RANGE LOOP + NULL; + END LOOP; + FOR J IN C31.X'FIRST..C31.X'LAST LOOP + NULL; + END LOOP; + I := C32.X'LENGTH; + C31.Y := C32'CONSTRAINED; + FOR J IN C32.X'RANGE LOOP + NULL; + END LOOP; + FOR J IN C32.X'FIRST..C32.X'LAST LOOP + NULL; + END LOOP; + I := C33'LENGTH; + FOR J IN C33'RANGE LOOP + NULL; + END LOOP; + FOR J IN C33'FIRST..C33'LAST LOOP + NULL; + END LOOP; + I := C34'LENGTH; + FOR J IN C34'RANGE LOOP + NULL; + END LOOP; + FOR J IN C34'FIRST..C34'LAST LOOP + NULL; + END LOOP; + I := C35'LENGTH; + FOR J IN C35'RANGE LOOP + NULL; + END LOOP; + FOR J IN C35'FIRST..C35'LAST LOOP + NULL; + END LOOP; + + Q(C31.Y'ADDRESS); + I := C31.Y'SIZE; + Q(C32.Y'ADDRESS); + I := C32.Y'SIZE; + Q(C36'ADDRESS); + I := C36'SIZE; + Q(C37'ADDRESS); + I := C37'SIZE; + Q(C38'ADDRESS); + I := C38'SIZE; + + END PROC; + + BEGIN + + NULL; + + END; + + RESULT; + + END A85007D; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a85013b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a85013b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a85013b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a85013b.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,89 ---- + -- A85013B.ADA + + -- 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. + --* + -- CHECK THAT: + + -- A) A SUBPROGRAM OR ENTRY CAN BE RENAMED WITHIN ITS OWN BODY. + + -- B) THE NEW NAME OF A SUBPROGRAM CAN BE USED IN A RENAMING + -- DECLARATION. + + -- EG 02/22/84 + + WITH REPORT; + + PROCEDURE A85013B IS + + USE REPORT; + + BEGIN + + TEST("A85013B","CHECK THAT A SUBPROGRAM CAN BE RENAMED WITHIN " & + "ITS OWN BODY AND THAT THE NEW NAME CAN BE USED" & + " IN A RENAMING DECLARATION"); + + DECLARE + + PROCEDURE PROC1 (A : BOOLEAN) IS + PROCEDURE PROC2 (B : BOOLEAN := FALSE) RENAMES PROC1; + PROCEDURE PROC3 (C : BOOLEAN := FALSE) RENAMES PROC2; + BEGIN + IF A THEN + PROC3; + END IF; + END PROC1; + + BEGIN + + PROC1 (TRUE); + + END; + + DECLARE + + TASK T IS + ENTRY E; + END T; + + TASK BODY T IS + PROCEDURE E1 RENAMES E; + PROCEDURE E2 RENAMES E1; + BEGIN + ACCEPT E DO + DECLARE + PROCEDURE E3 RENAMES E; + PROCEDURE E4 RENAMES E3; + BEGIN + NULL; + END; + END E; + END T; + + BEGIN + T.E; + END; + + RESULT; + + END A85013B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a87b59a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a87b59a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a87b59a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a87b59a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,250 ---- + -- A87B59A.ADA + + -- 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. + --* + -- CHECK THAT BECAUSE A GENERIC ACTUAL PROGRAM PARAMETER MUST BE A + -- SUBPROGRAM, AN ENUMERATION LITERAL, OR AN ENTRY WITH THE SAME + -- PARAMETER AND RESULT TYPE PROFILE AS THE FORMAL PARAMETER, AN + -- OVERLOADED NAME APPEARING AS AN ACTUAL PARAMETER CAN BE RESOLVED. + + -- R.WILLIAMS 9/24/86 + + WITH REPORT; USE REPORT; + PROCEDURE A87B59A IS + + BEGIN + TEST ( "A87B59A", "CHECK THAT BECAUSE A GENERIC ACTUAL PROGRAM " & + "PARAMETER MUST BE A SUBPROGRAM, AN " & + "ENUMERATION LITERAL, OR AN ENTRY WITH THE " & + "SAME PARAMETER AND RESULT TYPE PROFILE AS " & + "THE FORMAL PARAMETER, AN OVERLOADED NAME " & + "APPEARING AS AN ACTUAL PARAMETER CAN BE " & + "RESOLVED" ); + + DECLARE -- A. + FUNCTION F1 RETURN INTEGER IS + BEGIN + RETURN IDENT_INT (0); + END F1; + + FUNCTION F1 RETURN BOOLEAN IS + BEGIN + RETURN IDENT_BOOL (TRUE); + END F1; + + GENERIC + TYPE T IS (<>); + WITH FUNCTION F RETURN T; + PROCEDURE P; + + PROCEDURE P IS + BEGIN + NULL; + END P; + + PROCEDURE P1 IS NEW P (INTEGER, F1); + PROCEDURE P2 IS NEW P (BOOLEAN, F1); + + BEGIN + P1; + P2; + END; -- A. + + DECLARE -- B. + FUNCTION F1 (X : INTEGER; B : BOOLEAN) RETURN INTEGER IS + BEGIN + RETURN IDENT_INT (X); + END F1; + + FUNCTION F1 (X : INTEGER; B : BOOLEAN) RETURN BOOLEAN IS + BEGIN + RETURN IDENT_BOOL (B); + END F1; + + FUNCTION F1 (B : BOOLEAN; X : INTEGER) RETURN BOOLEAN IS + BEGIN + RETURN IDENT_BOOL (B); + END F1; + + GENERIC + TYPE T1 IS (<>); + TYPE T2 IS (<>); + WITH FUNCTION F (A : T1; B : T2) RETURN T1; + PROCEDURE P1; + + PROCEDURE P1 IS + BEGIN + NULL; + END P1; + + GENERIC + TYPE T1 IS (<>); + TYPE T2 IS (<>); + WITH FUNCTION F (A : T1; B : T2) RETURN T2; + PROCEDURE P2; + + PROCEDURE P2 IS + BEGIN + NULL; + END P2; + + PROCEDURE PROC1 IS NEW P1 (INTEGER, BOOLEAN, F1); + PROCEDURE PROC2 IS NEW P1 (BOOLEAN, INTEGER, F1); + PROCEDURE PROC3 IS NEW P2 (INTEGER, BOOLEAN, F1); + + BEGIN + PROC1; + PROC2; + END; -- B. + + DECLARE -- C. + TYPE COLOR IS (RED, YELLOW, BLUE); + C : COLOR; + + TYPE LIGHT IS (RED, YELLOW, GREEN); + L : LIGHT; + + GENERIC + TYPE T IS (<>); + WITH FUNCTION F RETURN T; + FUNCTION GF RETURN T; + + FUNCTION GF RETURN T IS + BEGIN + RETURN T'VAL (IDENT_INT (T'POS (F))); + END GF; + + FUNCTION F1 IS NEW GF (COLOR, RED); + FUNCTION F2 IS NEW GF (LIGHT, YELLOW); + BEGIN + C := F1; + L := F2; + END; -- C. + + DECLARE -- D. + TASK TK IS + ENTRY E (X : INTEGER); + ENTRY E (X : BOOLEAN); + ENTRY E (X : INTEGER; Y : BOOLEAN); + ENTRY E (X : BOOLEAN; Y : INTEGER); + END TK; + + TASK BODY TK IS + BEGIN + LOOP + SELECT + ACCEPT E (X : INTEGER); + OR + ACCEPT E (X : BOOLEAN); + OR + ACCEPT E (X : INTEGER; Y : BOOLEAN); + OR + ACCEPT E (X : BOOLEAN; Y : INTEGER); + OR + TERMINATE; + END SELECT; + END LOOP; + END TK; + + GENERIC + TYPE T1 IS (<>); + TYPE T2 IS (<>); + WITH PROCEDURE P1 (X : T1); + WITH PROCEDURE P2 (X : T1; Y : T2); + PACKAGE PKG IS + PROCEDURE P; + END PKG; + + PACKAGE BODY PKG IS + PROCEDURE P IS + BEGIN + IF EQUAL (3, 3) THEN + P1 (T1'VAL (1)); + P2 (T1'VAL (0), T2'VAL (1)); + END IF; + END P; + END PKG; + + PACKAGE PK1 IS NEW PKG (INTEGER, BOOLEAN, TK.E, TK.E); + PACKAGE PK2 IS NEW PKG (BOOLEAN, INTEGER, TK.E, TK.E); + + BEGIN + PK1.P; + PK2.P; + END; -- D. + + DECLARE -- E. + FUNCTION "+" (X, Y : BOOLEAN) RETURN BOOLEAN IS + BEGIN + RETURN IDENT_BOOL (X OR Y); + END "+"; + + GENERIC + TYPE T IS (<>); + WITH FUNCTION "+" (X, Y : T) RETURN T; + PROCEDURE P; + + PROCEDURE P IS + S : T; + BEGIN + S := "+" (T'VAL (0), T'VAL (1)); + END P; + + PROCEDURE P1 IS NEW P (BOOLEAN, "+"); + PROCEDURE P2 IS NEW P (INTEGER, "+"); + + BEGIN + P1; + P2; + END; -- E. + + DECLARE -- F. + TYPE ADD_OPS IS ('+', '-', '&'); + + GENERIC + TYPE T1 IS (<>); + TYPE T2 IS (<>); + TYPE T3 IS ARRAY (POSITIVE RANGE <> ) OF T2; + X2 : T2; + X3 : T3; + WITH FUNCTION F1 RETURN T1; + WITH FUNCTION F2 (X : T2; Y : T3) RETURN T3; + PROCEDURE P; + + PROCEDURE P IS + A : T1; + S : T3 (IDENT_INT (1) .. IDENT_INT (2)); + BEGIN + A := F1; + S := F2 (X2, X3); + END P; + + PROCEDURE P1 IS NEW P (ADD_OPS, CHARACTER, STRING, + '&', "&", '&', "&"); + + BEGIN + P1; + END; -- F. + + RESULT; + END A87B59A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a95001c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a95001c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a95001c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a95001c.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,74 ---- + -- A95001C.ADA + + -- 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. + --* + -- CHECK THAT IF THE BOUNDS OF THE DISCRETE RANGE OF AN ENTRY FAMILY + -- ARE INTEGER LITERALS, NAMED NUMBERS, OR ATTRIBUTES HAVING TYPE + -- UNIVERSAL_INTEGER, BUT NOT EXPRESSIONS OF TYPE UNIVERSAL_INTEGER, + -- THE INDEX (IN AN ENTRY NAME OR ACCEPT STATEMENT) IS OF THE + -- PREDEFINED TYPE INTEGER. + + -- WEI 3/4/82 + -- RJK 2/1/84 ADDED TO ACVC + -- TBN 1/7/86 RENAMED FROM B950DHA-B.ADA. ADDED NAMED CONSTANTS + -- AND ATTRIBUTES AS KINDS OF BOUNDS, AND MADE TEST + -- EXECUTABLE. + -- RJW 4/11/86 RENAMED FROM C95001C-B.ADA. + + WITH REPORT; USE REPORT; + + PROCEDURE A95001C IS + + SUBTYPE T IS INTEGER RANGE 1 .. 10; + I : INTEGER := 1; + NAMED_INT1 : CONSTANT := 1; + NAMED_INT2 : CONSTANT := 2; + + TASK T1 IS + ENTRY E1 (1 .. 2); + ENTRY E2 (NAMED_INT1 .. NAMED_INT2); + ENTRY E3 (T'POS(1) .. T'POS(2)); + END T1; + + TASK BODY T1 IS + I_INT : INTEGER := 1; + I_POS : INTEGER := 2; + BEGIN + ACCEPT E1 (I_INT); + ACCEPT E2 (I_POS); + ACCEPT E3 (T'SUCC(1)); + END T1; + + BEGIN + TEST ("A95001C", "CHECK THAT IF THE BOUNDS OF THE DISCRETE " & + "RANGE OF AN ENTRY FAMILY ARE INTEGER " & + "LITERALS, NAMED NUMBERS, OR " & + "(UNIVERSAL_INTEGER) ATTRIBUTES, THE INDEX " & + "IS OF THE PREDEFINED TYPE INTEGER"); + + T1.E1 (I); + T1.E2 (NAMED_INT2); + T1.E3 (T'SUCC(I)); + + RESULT; + END A95001C; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a95074d.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a95074d.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a95074d.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a95074d.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,82 ---- + -- A95074D.ADA + + -- 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. + --* + -- CHECK THAT 'ADDRESS, 'CONSTRAINED, 'SIZE, 'POSITION, 'FIRST_BIT, + -- AND 'LAST_BIT CAN BE APPLIED TO AN OUT PARAMETER OR OUT PARAMETER + -- SUBCOMPONENT THAT DOES NOT HAVE AN ACCESS TYPE. + + -- JWC 6/25/85 + + WITH REPORT; USE REPORT; + WITH SYSTEM; + PROCEDURE A95074D IS + BEGIN + + TEST ("A95074D", "CHECK THAT ATTRIBUTES MAY BE APPLIED TO " & + "NON-ACCESS FORMAL OUT PARAMETERS"); + + DECLARE + + TYPE ARR IS ARRAY (1 .. 2) OF BOOLEAN; + + TYPE REC (D : INTEGER := 1) IS RECORD + Y : BOOLEAN; + X : ARR; + END RECORD; + + TASK T IS + ENTRY E (C1 : OUT ARR; C2 : OUT REC); + END T; + + TASK BODY T IS + X : SYSTEM.ADDRESS; + I : INTEGER; + BEGIN + IF IDENT_BOOL (FALSE) THEN + ACCEPT E (C1 : OUT ARR; C2 : OUT REC) DO + + C2.Y := C2'CONSTRAINED; + + X := C1'ADDRESS; + X := C1(1)'ADDRESS; + X := C2'ADDRESS; + X := C2.Y'ADDRESS; + + I := C1'SIZE; + I := C2.Y'SIZE; + + I := C2.X'POSITION; + I := C2.Y'FIRST_BIT; + I := C2.Y'LAST_BIT; + END E; + END IF; + END T; + + BEGIN + NULL; + END; + + RESULT; + + END A95074D; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a97106a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a97106a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a97106a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a97106a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,86 ---- + -- A97106A.ADA + + -- 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. + --* + -- CHECK THAT A SELECTIVE_WAIT MAY HAVE MORE THAN ONE 'DELAY' ALTER- + -- NATIVE. + + + -- RM 4/27/1982 + + + WITH REPORT; + USE REPORT; + PROCEDURE A97106A IS + + + BEGIN + + + TEST ( "A97106A" , "CHECK THAT A SELECTIVE_WAIT MAY HAVE" & + " MORE THAN ONE 'DELAY' ALTERNATIVE" ); + + ------------------------------------------------------------------- + + + DECLARE + + + TASK TYPE TT IS + ENTRY A ; + END TT ; + + + TASK BODY TT IS + DUMMY : BOOLEAN := FALSE ; + BEGIN + + SELECT + ACCEPT A ; + OR + DELAY 2.5 ; + OR + ACCEPT A ; + OR + ACCEPT A ; + OR + DELAY 2.5 ; -- MULTIPLE 'DELAY'S PERMITTED (IF + OR -- AND ONLY IF SINGLE 'DELAY'S + DELAY 2.5 ; -- ARE PERMITTED). + OR + ACCEPT A ; + END SELECT ; + + END TT ; + + BEGIN + NULL ; + END ; + + ------------------------------------------------------------------- + + + RESULT; + + + END A97106A ; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a99006a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a99006a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/a99006a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/a99006a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,66 ---- + -- A99006A.ADA + + -- 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 'COUNT RETURNS A UNIVERSAL INTEGER VALUE. + + -- HISTORY: + -- DHH 03/28/88 CREATED ORIGINAL TEST. + + WITH SYSTEM; USE SYSTEM; + WITH REPORT; USE REPORT; + PROCEDURE A99006A IS + + TASK CHOICE IS + ENTRY START; + ENTRY E1; + ENTRY STOP; + END CHOICE; + + TASK BODY CHOICE IS + X : INTEGER; + BEGIN + ACCEPT START; + ACCEPT E1 DO + DECLARE + TYPE Y IS NEW INTEGER RANGE -5 .. 5; + T : Y := E1'COUNT; + BEGIN + X := E1'COUNT; + END; + END E1; + ACCEPT STOP; + END CHOICE; + + BEGIN + + TEST("A99006A", "CHECK THAT 'COUNT RETURNS A UNIVERSAL INTEGER " & + "VALUE"); + + CHOICE.START; + CHOICE.E1; + CHOICE.STOP; + + RESULT; + END A99006A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/aa2010a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/aa2010a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/aa2010a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/aa2010a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,199 ---- + -- AA2010A.ADA + + -- 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. + --* + -- CHECK THAT SUBUNIT NAMES CAN BE IDENTICAL TO IDENTIFIERS DECLARED IN + -- STANDARD, NAMELY, BOOLEAN, INTEGER, FLOAT, CHARACTER, ASCII, + -- NATURAL, POSITIVE, STRING, DURATION, CONSTRAINT_ERROR, + -- NUMERIC_ERROR, PROGRAM_ERROR, STORAGE_ERROR, AND TASKING_ERROR. + + -- R.WILLIAMS 9/18/86 + + PACKAGE AA2010A_TYPEDEF IS + TYPE ENUM IS (E1, E2, E3); + END AA2010A_TYPEDEF; + + WITH AA2010A_TYPEDEF; USE AA2010A_TYPEDEF; + PACKAGE AA2010A_PARENT IS + + PROCEDURE BOOLEAN; + FUNCTION INTEGER RETURN ENUM; + PACKAGE FLOAT IS END FLOAT; + + PROCEDURE CHARACTER; + FUNCTION ASCII RETURN ENUM; + + TASK NATURAL IS + ENTRY E; + END NATURAL; + + PROCEDURE POSITIVE; + FUNCTION STRING RETURN ENUM; + PACKAGE DURATION IS END DURATION; + + PROCEDURE CONSTRAINT_ERROR; + FUNCTION NUMERIC_ERROR RETURN ENUM; + + TASK PROGRAM_ERROR IS + ENTRY E; + END PROGRAM_ERROR; + + PROCEDURE STORAGE_ERROR; + FUNCTION TASKING_ERROR RETURN ENUM; + + END AA2010A_PARENT; + + PACKAGE BODY AA2010A_PARENT IS + + PROCEDURE BOOLEAN IS SEPARATE; + FUNCTION INTEGER RETURN ENUM IS SEPARATE; + PACKAGE BODY FLOAT IS SEPARATE; + + PROCEDURE CHARACTER IS SEPARATE; + FUNCTION ASCII RETURN ENUM IS SEPARATE; + TASK BODY NATURAL IS SEPARATE; + + PROCEDURE POSITIVE IS SEPARATE; + FUNCTION STRING RETURN ENUM IS SEPARATE; + PACKAGE BODY DURATION IS SEPARATE; + + PROCEDURE CONSTRAINT_ERROR IS SEPARATE; + FUNCTION NUMERIC_ERROR RETURN ENUM IS SEPARATE; + TASK BODY PROGRAM_ERROR IS SEPARATE; + + PROCEDURE STORAGE_ERROR IS SEPARATE; + FUNCTION TASKING_ERROR RETURN ENUM IS SEPARATE; + + END AA2010A_PARENT; + + SEPARATE (AA2010A_PARENT) + PROCEDURE BOOLEAN IS + BEGIN + NULL; + END; + + SEPARATE (AA2010A_PARENT) + FUNCTION INTEGER RETURN ENUM IS + BEGIN + RETURN E1; + END; + + SEPARATE (AA2010A_PARENT) + PACKAGE BODY FLOAT IS END; + + SEPARATE (AA2010A_PARENT) + PROCEDURE CHARACTER IS + BEGIN + NULL; + END; + + SEPARATE (AA2010A_PARENT) + FUNCTION ASCII RETURN ENUM IS + BEGIN + RETURN E1; + END; + + SEPARATE (AA2010A_PARENT) + TASK BODY NATURAL IS + BEGIN + ACCEPT E; + END; + + SEPARATE (AA2010A_PARENT) + PROCEDURE POSITIVE IS + BEGIN + NULL; + END; + + SEPARATE (AA2010A_PARENT) + FUNCTION STRING RETURN ENUM IS + BEGIN + RETURN E1; + END; + + SEPARATE (AA2010A_PARENT) + PACKAGE BODY DURATION IS END; + + SEPARATE (AA2010A_PARENT) + PROCEDURE CONSTRAINT_ERROR IS + BEGIN + NULL; + END; + + SEPARATE (AA2010A_PARENT) + FUNCTION NUMERIC_ERROR RETURN ENUM IS + BEGIN + RETURN E1; + END; + + SEPARATE (AA2010A_PARENT) + TASK BODY PROGRAM_ERROR IS + BEGIN + ACCEPT E; + END; + + SEPARATE (AA2010A_PARENT) + PROCEDURE STORAGE_ERROR IS + BEGIN + NULL; + END; + + SEPARATE (AA2010A_PARENT) + FUNCTION TASKING_ERROR RETURN ENUM IS + BEGIN + RETURN E1; + END; + + WITH REPORT; USE REPORT; + WITH AA2010A_TYPEDEF; USE AA2010A_TYPEDEF; + WITH AA2010A_PARENT; USE AA2010A_PARENT; + PROCEDURE AA2010A IS + E : ENUM; + BEGIN + TEST ( "AA2010A", "CHECK THAT SUBUNIT NAMES CAN BE IDENTICAL " & + "TO IDENTIFIERS DECLARED IN STANDARD, " & + "NAMELY, BOOLEAN, INTEGER, FLOAT, " & + "CHARACTER, ASCII, NATURAL, POSITIVE, " & + "STRING, DURATION, CONSTRAINT_ERROR, " & + "NUMERIC_ERROR, PROGRAM_ERROR, " & + "STORAGE_ERROR, AND TASKING_ERROR" ); + + AA2010A_PARENT.BOOLEAN; + E := AA2010A_PARENT.INTEGER; + + AA2010A_PARENT.CHARACTER; + E := AA2010A_PARENT.ASCII; + AA2010A_PARENT.NATURAL.E; + + AA2010A_PARENT.POSITIVE; + E := AA2010A_PARENT.STRING; + + AA2010A_PARENT.CONSTRAINT_ERROR; + E := AA2010A_PARENT.NUMERIC_ERROR; + AA2010A_PARENT.PROGRAM_ERROR.E; + + AA2010A_PARENT.STORAGE_ERROR; + E := AA2010A_PARENT.TASKING_ERROR; + + RESULT; + END AA2010A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/aa2012a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/aa2012a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/aa2012a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/aa2012a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,70 ---- + -- AA2012A.ADA + + -- 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. + --* + -- CHECK THAT A BODY STUB CAN SERVE AS AN IMPLICIT DECLARATION OF A + -- SUBPROGRAM, I.E., A PRECEDING SUBPROGRAM DECLARATION IS NOT + -- REQUIRED. + + -- R.WILLIAMS 9/18/86 + + PROCEDURE AA2012A1 IS + + I : INTEGER; + + PROCEDURE AA2012A2 IS SEPARATE; + + FUNCTION AA2012A3 RETURN INTEGER IS SEPARATE; + + BEGIN + AA2012A2; + I := AA2012A3; + + END AA2012A1; + + SEPARATE (AA2012A1) + PROCEDURE AA2012A2 IS + BEGIN + NULL; + END; + + SEPARATE (AA2012A1) + FUNCTION AA2012A3 RETURN INTEGER IS + BEGIN + RETURN 5; + END; + + WITH AA2012A1; + WITH REPORT; USE REPORT; + PROCEDURE AA2012A IS + + BEGIN + TEST ( "AA2012A", "CHECK THAT A BODY STUB CAN SERVE AS AN " & + "IMPLICIT DECLARATION OF A SUBPROGRAM, " & + "I.E., A PRECEDING SUBPROGRAM DECLARATION " & + "IS NOT REQUIRED" ); + + AA2012A1; + + RESULT; + END AA2012A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ac1015b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ac1015b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ac1015b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ac1015b.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,81 ---- + -- AC1015B.ADA + + -- 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 WITHIN A GENERIC SUBPROGRAM THE NAME OF THE GENERIC + -- SUBPROGRAM CAN BE USED AS AN ACTUAL PARAMETER IN AN + -- INSTANTIATION. + + -- HISTORY: + -- BCB 03/28/88 CREATED ORIGINAL TEST. + + WITH REPORT; USE REPORT; + + PROCEDURE AC1015B IS + + GENERIC + PROCEDURE P; + + PROCEDURE P IS + GENERIC + WITH PROCEDURE F; + PROCEDURE T; + + PROCEDURE T IS + BEGIN + NULL; + END T; + + PROCEDURE S IS NEW T(F => P); + + BEGIN + NULL; + END P; + + GENERIC + FUNCTION D RETURN BOOLEAN; + + FUNCTION D RETURN BOOLEAN IS + GENERIC + WITH FUNCTION L RETURN BOOLEAN; + FUNCTION A RETURN BOOLEAN; + + FUNCTION A RETURN BOOLEAN IS + BEGIN + RETURN TRUE; + END A; + + FUNCTION B IS NEW A(L => D); + + BEGIN + RETURN TRUE; + END D; + + BEGIN + TEST ("AC1015B", "CHECK THAT WITHIN A GENERIC SUBPROGRAM THE " & + "NAME OF THE GENERIC SUBPROGRAM CAN BE USED AS " & + "AN ACTUAL PARAMETER IN AN INSTANTIATION"); + + RESULT; + END AC1015B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ac3106a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ac3106a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ac3106a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ac3106a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,216 ---- + -- AC3106A.ADA + + -- 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 AN ACTUAL GENERIC IN OUT PARAMETER CAN BE: + -- A) ANY SUBCOMPONENT THAT DOES NOT DEPEND ON A DISCRIMINANT, + -- EVEN IF THE ENCLOSING VARIABLE IS UNCONSTRAINED; + -- B) ANY SUBCOMPONENT OF AN UNCONSTAINED VARIABLE OF A + -- RECORD TYPE IF THE DISCRIMINANTS OF THE + -- VARIABLE DO NOT HAVE DEFAULTS AND THE VARIABLE IS NOT + -- A GENERIC FORMAL IN OUT PARAMETER; + -- C) ANY COMPONENT OF AN OBJECT DESIGNATED BY AN ACCESS + -- VALUE. + + -- HISTORY: + -- RJW 11/07/88 CREATED ORIGINAL TEST. + + WITH REPORT; USE REPORT; + PROCEDURE AC3106A IS + + SUBTYPE INT IS INTEGER RANGE 0 .. 10; + + TYPE REC (D : INT := 0) IS RECORD + A : INTEGER := 5; + CASE D IS + WHEN OTHERS => + V : INTEGER := 5; + END CASE; + END RECORD; + + TYPE AR_REC IS ARRAY (1 .. 10) OF REC; + + TYPE R_REC IS RECORD + E : REC; + END RECORD; + + TYPE A_STRING IS ACCESS STRING; + TYPE A_REC IS ACCESS REC; + TYPE A_AR_REC IS ACCESS AR_REC; + TYPE A_R_REC IS ACCESS R_REC; + + TYPE DIS (L : INT := 1) IS RECORD + S : STRING (1 .. L) := "A"; + R : REC (L); + AS : A_STRING (1 .. L) := NEW STRING (1 .. L); + AR : A_REC (L) := NEW REC (1); + RC : REC (3); + ARU : A_REC := NEW REC; + V_AR : AR_REC; + V_R : R_REC; + AC_AR : A_AR_REC := NEW AR_REC; + AC_R : A_R_REC := NEW R_REC; + END RECORD; + + TYPE A_DIS IS ACCESS DIS; + AD : A_DIS := NEW DIS; + + TYPE DIS2 (L : INT) IS RECORD + S : STRING (1 .. L); + R : REC (L); + AS : A_STRING (1 .. L); + AR : A_REC (L); + END RECORD; + + X : DIS; + + SUBTYPE REC3 IS REC (3); + + GENERIC + GREC3 : IN OUT REC3; + PACKAGE PREC3 IS END PREC3; + + SUBTYPE REC0 IS REC (0); + + GENERIC + GREC0 : IN OUT REC0; + PACKAGE PREC0 IS END PREC0; + + GENERIC + GINT : IN OUT INTEGER; + PACKAGE PINT IS END PINT; + + GENERIC + GA_REC : IN OUT A_REC; + PACKAGE PA_REC IS END PA_REC; + + GENERIC + GAR_REC : IN OUT AR_REC; + PACKAGE PAR_REC IS END PAR_REC; + + GENERIC + GR_REC : IN OUT R_REC; + PACKAGE PR_REC IS END PR_REC; + + GENERIC + GA_AR_REC : IN OUT A_AR_REC; + PACKAGE PA_AR_REC IS END PA_AR_REC; + + GENERIC + GA_R_REC : IN OUT A_R_REC; + PACKAGE PA_R_REC IS END PA_R_REC; + + TYPE BUFFER (SIZE : INT) IS RECORD + POS : NATURAL := 0; + VAL : STRING (1 .. SIZE); + END RECORD; + + SUBTYPE BUFF_5 IS BUFFER (5); + + GENERIC + Y : IN OUT CHARACTER; + PACKAGE P_CHAR IS END P_CHAR; + + SUBTYPE STRING5 IS STRING (1 .. 5); + GENERIC + GSTRING : STRING5; + PACKAGE P_STRING IS END P_STRING; + + GENERIC + GA_STRING : A_STRING; + PACKAGE P_A_STRING IS END P_A_STRING; + + GENERIC + X : IN OUT BUFF_5; + PACKAGE P_BUFF IS + RX : BUFF_5 RENAMES X; + END P_BUFF; + + Z : BUFFER (1) := (SIZE => 1, POS =>82, VAL =>"R"); + BEGIN + TEST ("AC3106A", "CHECK THE PERMITTED FORMS OF AN ACTUAL " & + "GENERIC IN OUT PARAMETER"); + + DECLARE -- A) + PACKAGE NPINT3 IS NEW PINT (X.RC.A); + PACKAGE NPINT4 IS NEW PINT (X.RC.V); + PACKAGE NPREC3 IS NEW PREC3 (X.RC); + PACKAGE NPA_REC IS NEW PA_REC (X.ARU); + PACKAGE NPINT5 IS NEW PINT (X.ARU.A); + PACKAGE NPINT6 IS NEW PINT (X.ARU.V); + PACKAGE NPAR_REC IS NEW PAR_REC (X.V_AR); + PACKAGE NPREC01 IS NEW PREC0 (X.V_AR (1)); + PACKAGE NPR_REC IS NEW PR_REC (X.V_R); + PACKAGE NPREC02 IS NEW PREC0 (X.V_R.E); + PACKAGE NPINT7 IS NEW PINT (X.V_R.E.A); + + PACKAGE NP_BUFF IS NEW P_BUFF (Z); + USE NP_BUFF; + + PACKAGE NP_CHAR3 IS NEW P_CHAR (RX.VAL (1)); + + PROCEDURE PROC (X : IN OUT BUFFER) IS + PACKAGE NP_CHAR4 IS NEW P_CHAR (X.VAL (1)); + BEGIN + NULL; + END; + BEGIN + NULL; + END; -- A) + + DECLARE -- B) + PROCEDURE PROC (Y : IN OUT DIS2) IS + PACKAGE NP_STRING IS NEW P_STRING (Y.S); + PACKAGE NP_CHAR IS NEW P_CHAR (Y.S (1)); + PACKAGE NP_A_STRING IS NEW P_A_STRING (Y.AS); + PACKAGE NP_CHAR2 IS NEW P_CHAR (Y.AS (1)); + PACKAGE NPINT3 IS NEW PINT (Y.R.A); + PACKAGE NPINT4 IS NEW PINT (Y.R.V); + PACKAGE NPREC3 IS NEW PREC3 (Y.R); + PACKAGE NPA_REC IS NEW PA_REC (Y.AR); + PACKAGE NPINT5 IS NEW PINT (Y.AR.A); + PACKAGE NPINT6 IS NEW PINT (Y.AR.V); + BEGIN + NULL; + END; + BEGIN + NULL; + END; -- B) + + DECLARE -- C) + PACKAGE NP_CHAR IS NEW P_CHAR (AD.S (1)); + PACKAGE NP_A_STRING IS NEW P_A_STRING (AD.AS); + PACKAGE NP_CHAR2 IS NEW P_CHAR (AD.AS (1)); + PACKAGE NPINT3 IS NEW PINT (AD.R.A); + PACKAGE NPINT4 IS NEW PINT (AD.R.V); + PACKAGE NPREC3 IS NEW PREC3 (AD.R); + PACKAGE NPA_REC IS NEW PA_REC (AD.AR); + PACKAGE NPINT5 IS NEW PINT (AD.AR.A); + PACKAGE NPINT6 IS NEW PINT (AD.AR.V); + BEGIN + NULL; + END; -- C) + + RESULT; + END AC3106A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ac3206a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ac3206a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ac3206a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ac3206a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,120 ---- + -- AC3206A.ADA + + -- 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 AN INSTANTIATION IS LEGAL IF A FORMAL PRIVATE TYPE IS + -- USED IN A CONSTANT DECLARATION AND THE ACTUAL PARAMETER IS A + -- TYPE WITH DISCRIMINANTS THAT DO AND DO NOT HAVE DEFAULTS. (CHECK + -- CASES THAT USED TO BE FORBIDDEN). + + -- HISTORY: + -- DHH 09/16/88 CREATED ORIGINAL TEST. + + WITH REPORT; USE REPORT; + PROCEDURE AC3206A IS + + BEGIN + TEST ("AC3206A", "CHECK THAT AN INSTANTIATION IS LEGAL IF A " & + "FORMAL PRIVATE TYPE IS USED IN A CONSTANT " & + "DECLARATION AND THE ACTUAL PARAMETER IS A " & + "TYPE WITH DISCRIMINANTS THAT DO AND DO NOT " & + "HAVE DEFAULTS"); + + DECLARE -- CHECK DEFAULTS LEGAL UNDER AI-37. + + GENERIC + TYPE GEN IS PRIVATE; + INIT : GEN; + PACKAGE GEN_PACK IS + CONST : CONSTANT GEN := INIT; + SUBTYPE NEW_GEN IS GEN; + END GEN_PACK; + + TYPE REC(A : INTEGER := 4) IS + RECORD + X : INTEGER; + Y : BOOLEAN; + END RECORD; + + PACKAGE P IS NEW GEN_PACK(REC, (4, 5, FALSE)); + USE P; + + CON : CONSTANT P.NEW_GEN := (4, 5, FALSE); + + BEGIN + NULL; + END; + + DECLARE + + GENERIC + TYPE GEN(DIS : INTEGER) IS PRIVATE; + INIT : GEN; + PACKAGE GEN_PACK IS + CONST : CONSTANT GEN := INIT; + SUBTYPE NEW_GEN IS GEN(4); + END GEN_PACK; + + TYPE REC(A : INTEGER := 4) IS + RECORD + X : INTEGER; + Y : BOOLEAN; + END RECORD; + + PACKAGE P IS NEW GEN_PACK(REC, (4, 5, FALSE)); + USE P; + + CON : CONSTANT P.NEW_GEN := (4, 5, FALSE); + + BEGIN + NULL; + END; + + DECLARE + + GENERIC + TYPE GEN(DIS : INTEGER) IS PRIVATE; + INIT : GEN; + PACKAGE GEN_PACK IS + CONST : CONSTANT GEN := INIT; + SUBTYPE NEW_GEN IS GEN(4); + END GEN_PACK; + + TYPE REC(A : INTEGER) IS + RECORD + X : INTEGER; + Y : BOOLEAN; + END RECORD; + + PACKAGE P IS NEW GEN_PACK(REC, (4, 5, FALSE)); + USE P; + + CON : CONSTANT P.NEW_GEN := (4, 5, FALSE); + + BEGIN + NULL; + END; + + RESULT; + END AC3206A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ac3207a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ac3207a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ac3207a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ac3207a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,92 ---- + -- AC3207A.ADA + + -- 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 AN INSTANTIATION IS LEGAL IF A FORMAL PARAMETER + -- HAVING A LIMITED PRIVATE TYPE WITHOUT DISCRIMINANTS IS USED TO + -- DECLARE AN OBJECT IN A BLOCK THAT CONTAINS A SELECTIVE WAIT + -- WITH A TERMINATE ALTERNATIVE, AND THE ACTUAL PARAMETER'S BASE + -- TYPE IS A TASK TYPE OR A TYPE WITH A SUBCOMPONENT OF A TASK TYPE. + + -- HISTORY: + -- DHH 09/16/88 CREATED ORIGINAL TEST. + + WITH REPORT; USE REPORT; + PROCEDURE AC3207A IS + + GENERIC + TYPE PRIV IS LIMITED PRIVATE; + PACKAGE GEN_P IS + TASK T1 IS + ENTRY E; + END T1; + END GEN_P; + + TASK TYPE TASK_T IS + END TASK_T; + + TYPE REC IS + RECORD + OBJ : TASK_T; + END RECORD; + + PACKAGE BODY GEN_P IS + TASK BODY T1 IS + BEGIN + DECLARE + OBJ : PRIV; + BEGIN + SELECT + ACCEPT E; + OR + TERMINATE; + END SELECT; + END; + END T1; + END GEN_P; + + TASK BODY TASK_T IS + BEGIN + NULL; + END; + + PACKAGE P IS NEW GEN_P(TASK_T); + PACKAGE NEW_P IS NEW GEN_P(REC); + + BEGIN + TEST ("AC3207A", "CHECK THAT AN INSTANTIATION IS LEGAL IF A " & + "FORMAL PARAMETER HAVING A LIMITED PRIVATE " & + "TYPE WITHOUT DISCRIMINANTS IS USED TO " & + "DECLARE AN OBJECT IN A BLOCK THAT CONTAINS " & + "A SELECTIVE WAIT WITH A TERMINATE " & + "ALTERNATIVE, AND THE ACTUAL PARAMETER'S BASE " & + "TYPE IS A TASK TYPE OR A TYPE WITH A " & + "SUBCOMPONENT OF A TASK TYPE"); + + P.T1.E; + + NEW_P.T1.E; + + RESULT; + END AC3207A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7001b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7001b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7001b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7001b.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,66 ---- + -- AD7001B.ADA + + -- 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 A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE + -- IF A WITH CLAUSE NAMING SYSTEM IS PROVIDED FOR THE UNIT + -- CONTAINING THE REFERENCES. + + -- HISTORY: + -- JET 09/08/87 CREATED ORIGINAL TEST. + -- VCL 03/30/88 CREATED NAMED NUMBERS WITH VALUES OF + -- SYSTEM.MIN_INT AND SYSTEM.MAX_INT. DELETED + -- ASSIGNMENTS OF MIN_INT AND MAX_INT TO INTEGER + -- VARIABLES. + + WITH SYSTEM; + WITH REPORT; USE REPORT; + + PROCEDURE AD7001B IS + + CHECK_ADDRESS : SYSTEM.ADDRESS; + CHECK_NAME : SYSTEM.NAME := SYSTEM.SYSTEM_NAME; + CHECK_PRIORITY : SYSTEM.PRIORITY; + I : INTEGER; + F : FLOAT; + SMALL : CONSTANT := SYSTEM.MIN_INT; + LARGE : CONSTANT := SYSTEM.MAX_INT; + MEM : CONSTANT := SYSTEM.MEMORY_SIZE; + + BEGIN + + TEST ("AD7001B", "CHECK THAT A DECLARATION IN PACKAGE " & + "SYSTEM IS ACCESSIBLE IF A WITH CLAUSE " & + "NAMING SYSTEM IS PROVIDED FOR THE UNIT " & + "CONTAINING THE REFERENCES"); + + I := SYSTEM.STORAGE_UNIT; + I := SYSTEM.MAX_DIGITS; + I := SYSTEM.MAX_MANTISSA; + F := SYSTEM.FINE_DELTA; + F := SYSTEM.TICK; + + RESULT; + + END AD7001B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7001c0.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7001c0.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7001c0.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7001c0.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,65 ---- + -- AD7001C0M.ADA + + -- 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 A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE + -- IN A LIBRARY PACKAGE BODY IF A WITH CLAUSE NAMING SYSTEM + -- IS PROVIDED FOR THE PACKAGE SPECIFICATION, ALTHOUGH IN A + -- SEPARATE FILE. + + -- HISTORY: + -- JET 09/09/87 CREATED ORIGINAL TEST. + -- RJW 05/03/88 REVISED AND ENTERED TEST INTO ACVC. + -- PWN 05/25/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL. + + -- THIS FILE CONTAINS PACKAGE SPEC AD7001C_PACKAGE AND THE MAIN + -- PROCEDURE FOR TEST AD7001C. FILE AD7001C1.ADA CONTAINS + -- THE PACKAGE BODY FOR THE PACKAGE SPEC AND IS ALSO REQUIRED + -- FOR TEST EXECUTION. + + WITH SYSTEM; + + PACKAGE AD7001C_PACKAGE IS + + I : INTEGER; + F : FLOAT; + + PROCEDURE REQUIRE_BODY; + + END AD7001C_PACKAGE; + + + WITH AD7001C_PACKAGE; USE AD7001C_PACKAGE; + WITH REPORT; USE REPORT; + + PROCEDURE AD7001C0M IS + + BEGIN + TEST ("AD7001C", "CHECK THAT A DECLARATION IN PACKAGE SYSTEM " & + "IS ACCESSIBLE IN A LIBRARY PACKAGE BODY IF " & + "A WITH CLAUSE NAMING SYSTEM IS PROVIDED FOR " & + "THE PACKAGE SPECIFICATION, ALTHOUGH IN A " & + "SEPARATE FILE"); + RESULT; + END AD7001C0M; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7001c1.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7001c1.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7001c1.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7001c1.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,60 ---- + -- AD7001C1.ADA + + -- 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 A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE + -- IN A LIBRARY PACKAGE BODY IF A WITH CLAUSE NAMING SYSTEM + -- IS PROVIDED FOR THE PACKAGE SPECIFICATION, ALTHOUGH IN ANOTHER + -- FILE. + + -- HISTORY: + -- JET 09/09/87 CREATED ORIGINAL TEST. + -- RJW 05/03/88 REVISED AND ENTERED IN ACVC. + -- PWN 05/25/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL. + + -- THIS FILE CONTAINS THE PACKAGE BODY FOR PACKAGE AD7001C_PACKAGE. + -- FILE AD7001C0M.ADA CONTAINS THE PACKAGE SPEC AND MAIN PROCEDURE + -- FOR TEST AD7001C AND IS ALSO REQUIRED FOR TEST EXECUTION. + + PACKAGE BODY AD7001C_PACKAGE IS + + CHECK_ADDRESS : SYSTEM.ADDRESS; + CHECK_NAME : SYSTEM.NAME := SYSTEM.SYSTEM_NAME; + CHECK_PRIORITY : SYSTEM.PRIORITY; + MEM_SIZE : CONSTANT := SYSTEM.MEMORY_SIZE; + + TYPE INTRANGE IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT; + + PROCEDURE REQUIRE_BODY IS + BEGIN + NULL; + END; + + BEGIN + I := SYSTEM.STORAGE_UNIT; + I := SYSTEM.MAX_DIGITS; + I := SYSTEM.MAX_MANTISSA; + F := SYSTEM.FINE_DELTA; + F := SYSTEM.TICK; + END AD7001C_PACKAGE; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7001d0.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7001d0.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7001d0.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7001d0.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,60 ---- + -- AD7001D0M.ADA + + -- 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 A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE + -- IN A SUBUNIT IF A WITH CLAUSE NAMING SYSTEM IS PROVIDED + -- FOR THE MAIN UNIT CONTAINING THE SUBUNIT, ALTHOUGH IN A + -- SEPARATE FILE. + + -- HISTORY: + -- JET 09/09/87 CREATED ORIGINAL TEST. + -- RJW 05/03/88 REVISED AND ENTERED TEST INTO ACVC. + + -- THIS FILE CONTAINS THE MAIN PROCEDURE FOR TEST AD7001D. FILE + -- AD7001D1.ADA CONTAINS THE PACKAGE BODY FOR THE SUBUNIT PACKAGE + -- SPEC AND IS ALSO REQUIRED FOR TEST EXECUTION. + + WITH SYSTEM; + WITH REPORT; USE REPORT; + + PROCEDURE AD7001D0M IS + + PACKAGE AD7001D_PACKAGE IS + + I : INTEGER; + F : FLOAT; + + END AD7001D_PACKAGE; + + PACKAGE BODY AD7001D_PACKAGE IS SEPARATE; + + BEGIN + TEST ("AD7001D", "CHECK THAT A DECLARATION IN PACKAGE SYSTEM " & + "IS ACCESSIBLE IN A SUBUNIT IF A WITH CLAUSE " & + "NAMING SYSTEM IS PROVIDED FOR THE MAIN UNIT " & + "CONTAINING THE SUBUNIT, ALTHOUGH IN A " & + "SEPARATE FILE"); + RESULT; + END AD7001D0M; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7001d1.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7001d1.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7001d1.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7001d1.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,55 ---- + -- AD7001D1.ADA + + -- 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 A DECLARATION IN PACKAGE SYSTEM IS ACCESSIBLE IN + -- A SUBUNIT IF A WITH CLAUSE NAMING SYSTEM IS PROVIDED FOR THE + -- MAIN UNIT CONTAINING THE SUBUNIT, ALTHOUGH IN A SEPARATE + -- FILE. + + -- HISTORY: + -- JET 09/09/87 CREATED ORIGINAL TEST. + + -- THIS FILE CONTAINS THE PACKAGE BODY FOR PACKAGE AD7001D_PACKAGE. + -- FILE AD7001D0M.ADA CONTAINS THE PACKAGE SPEC AND MAIN PROCEDURE + -- FOR TEST AD7001D AND IS ALSO REQUIRED FOR TEST EXECUTION. + + SEPARATE (AD7001D0M) + + PACKAGE BODY AD7001D_PACKAGE IS + + CHECK_ADDRESS : SYSTEM.ADDRESS; + CHECK_NAME : SYSTEM.NAME := SYSTEM.SYSTEM_NAME; + CHECK_PRIORITY : SYSTEM.PRIORITY; + MEM_SIZE : CONSTANT := SYSTEM.MEMORY_SIZE; + + TYPE INTRANGE IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT; + + BEGIN + I := SYSTEM.STORAGE_UNIT; + I := SYSTEM.MAX_DIGITS; + I := SYSTEM.MAX_MANTISSA; + F := SYSTEM.FINE_DELTA; + F := SYSTEM.TICK; + END AD7001D_PACKAGE; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7006a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7006a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7006a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7006a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,47 ---- + -- AD7006A.ADA + + -- 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 THE CONSTANT 'SYSTEM.MEMORY_SIZE' IS DECLARED AND + -- THAT IT IS A STATIC UNIVERSAL INTEGER. + + -- HISTORY: + -- VCL 09/14/87 CREATED ORIGINAL TEST. + -- RJW 06/13/89 MODIFIED TEST AND REMOVED INTEGER VARIABLE. + + WITH SYSTEM; + WITH REPORT; USE REPORT; + PROCEDURE AD7006A IS + BEGIN + TEST ("AD7006A", "THE CONSTANT 'SYSTEM.MEMORY_SIZE' IS " & + "DECLARED AND IT IS A STATIC UNIVERSAL " & + "INTEGER"); + + DECLARE + MY_MSIZE : CONSTANT := SYSTEM.MEMORY_SIZE - 1; + BEGIN + RESULT; + END; + + END AD7006A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7101a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7101a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7101a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7101a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,51 ---- + -- AD7101A.ADA + + -- 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 MIN_INT AND MAX_INT ARE DECLARED IN PACKAGE SYSTEM + -- AND THAT BOTH ARE STATIC AND HAVE TYPE . + + -- HISTORY: + -- JET 09/10/87 CREATED ORIGINAL TEST. + + WITH SYSTEM; + WITH REPORT; USE REPORT; + + PROCEDURE AD7101A IS + + U_MIN : CONSTANT := SYSTEM.MIN_INT; + U_MAX : CONSTANT := SYSTEM.MAX_INT; + + TYPE S_MIN IS RANGE SYSTEM.MIN_INT .. 7; + TYPE S_MAX IS RANGE 7 .. SYSTEM.MAX_INT; + + BEGIN + + TEST ("AD7101A", "CHECK THAT MIN_INT AND MAX_INT ARE DECLARED " & + "IN PACKAGE SYSTEM AND THAT BOTH ARE STATIC " & + "AND HAVE TYPE "); + + RESULT; + + END AD7101A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7101c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7101c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7101c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7101c.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,50 ---- + -- AD7101C.ADA + + -- 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 TYPE DEFINITIONS WITH RANGES -MAX_INT .. MAX_INT + -- AND MIN_INT .. MAX_INT ARE ACCEPTED. + + -- HISTORY: + -- JET 09/10/87 CREATED ORIGINAL TEST. + -- VCL 03/30/88 CHANGED INTEGER SUBTYPE DECLARATIONS TO TYPE + -- DEFINITIONS. + + WITH SYSTEM; USE SYSTEM; + WITH REPORT; USE REPORT; + + PROCEDURE AD7101C IS + + TYPE CHECK1 IS RANGE -MAX_INT .. MAX_INT; + TYPE CHECK2 IS RANGE MIN_INT .. MAX_INT; + + BEGIN + + TEST ("AD7101C", "CHECK THAT TYPE DEFINITIONS WITH RANGES " & + "-MAX_INT .. MAX_INT AND MIN_INT .. MAX_INT " & + "ARE ACCEPTED"); + + RESULT; + + END AD7101C; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7102a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7102a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7102a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7102a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,50 ---- + -- AD7102A.ADA + + -- 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 THE CONSTANT MAX_DIGITS IS DECLARED WITHIN THE + -- PACKAGE SYSTEM, THAT ITS TYPE IS , AND THAT + -- ITS VALUE IS STATIC. + + -- HISTORY: + -- BCB 09/10/87 CREATED ORIGINAL TEST. + + WITH SYSTEM; + WITH REPORT; USE REPORT; + + PROCEDURE AD7102A IS + + U_DIGITS : CONSTANT := SYSTEM.MAX_DIGITS; + + TYPE S_DIGITS IS RANGE 7 .. SYSTEM.MAX_DIGITS; + + BEGIN + + TEST ("AD7102A", "CHECK THAT THE CONSTANT MAX_DIGITS IS " & + "DECLARED WITHIN THE PACKAGE SYSTEM, THAT ITS " & + "TYPE IS , AND THAT ITS " & + "VALUE IS STATIC"); + RESULT; + + END AD7102A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7103a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7103a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7103a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7103a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,50 ---- + -- AD7103A.ADA + + -- 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 THE CONSTANT MAX_MANTISSA IS DECLARED WITHIN THE + -- PACKAGE SYSTEM, THAT ITS TYPE IS , AND THAT + -- ITS VALUE IS STATIC. + + -- HISTORY: + -- BCB 09/10/87 CREATED ORIGINAL TEST. + + WITH SYSTEM; + WITH REPORT; USE REPORT; + + PROCEDURE AD7103A IS + + U_MANTISSA : CONSTANT := SYSTEM.MAX_MANTISSA; + + TYPE S_MANTISSA IS RANGE 7 .. SYSTEM.MAX_MANTISSA; + + BEGIN + + TEST ("AD7103A", "CHECK THAT THE CONSTANT MAX_MANTISSA IS " & + "DECLARED WITHIN THE PACKAGE SYSTEM, THAT ITS " & + "TYPE IS , AND THAT ITS " & + "VALUE IS STATIC"); + RESULT; + + END AD7103A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7103c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7103c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7103c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7103c.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,50 ---- + -- AD7103C.ADA + + -- 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 THE CONSTANT FINE_DELTA IS DECLARED WITHIN THE + -- PACKAGE SYSTEM, THAT ITS TYPE IS , AND THAT + -- ITS VALUE IS STATIC. + + -- HISTORY: + -- BCB 09/10/87 CREATED ORIGINAL TEST. + + WITH SYSTEM; + WITH REPORT; USE REPORT; + + PROCEDURE AD7103C IS + + U_DELTA : CONSTANT := SYSTEM.FINE_DELTA; + + TYPE S_DELTA IS DELTA SYSTEM.FINE_DELTA RANGE -1.0 .. 1.0; + + BEGIN + + TEST ("AD7103C", "CHECK THAT THE CONSTANT FINE_DELTA IS " & + "DECLARED WITHIN THE PACKAGE SYSTEM, THAT ITS " & + "TYPE IS , AND THAT ITS " & + "VALUE IS STATIC"); + RESULT; + + END AD7103C; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7104a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7104a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7104a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7104a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,50 ---- + -- AD7104A.ADA + + -- 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 THE CONSTANT TICK IS DECLARED WITHIN THE PACKAGE + -- SYSTEM, THAT ITS TYPE IS , AND THAT ITS VALUE + -- IS STATIC. + + -- HISTORY: + -- BCB 09/10/87 CREATED ORIGINAL TEST. + + WITH SYSTEM; + WITH REPORT; USE REPORT; + + PROCEDURE AD7104A IS + + U_TICK: CONSTANT := SYSTEM.TICK; + + F : FLOAT := SYSTEM.TICK; + + BEGIN + + TEST ("AD7104A", "CHECK THAT THE CONSTANT TICK IS DECLARED " & + "WITHIN THE PACKAGE SYSTEM, THAT ITS TYPE IS " & + ", AND THAT ITS VALUE IS STATIC"); + + RESULT; + + END AD7104A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7201a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7201a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7201a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7201a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,98 ---- + -- AD7201A.ADA + + -- 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 THE PREFIX OF THE 'ADDRESS ATTRIBUTE CAN DENOTE A + -- PACKAGE, SUBPROGRAM, TASK TYPE, SINGLE TASK, AND LABEL. + + -- HISTORY: + -- DHH 09/01/88 CREATED ORIGINAL TEST. + -- RJW 02/23/90 REMOVED TESTS FOR THE 'ADDRESS ATTRIBUTE APPLIED TO + -- A GENERIC UNIT. REMOVED DECLARATION OF TYPE + -- "COLOR". + -- DTN 11/22/91 DELETED SUBPART (A). + + WITH SYSTEM; + WITH REPORT; USE REPORT; + PROCEDURE AD7201A IS + + SUBTYPE MY_ADDRESS IS SYSTEM.ADDRESS; + + BEGIN + TEST ("AD7201A", "CHECK THAT THE PREFIX OF THE 'ADDRESS " & + "ATTRIBUTE CAN DENOTE A PACKAGE, " & + "SUBPROGRAM, TASK TYPE, SINGLE TASK, AND LABEL"); + + DECLARE + PACKAGE B IS + END B; + B1 : BOOLEAN := (B'ADDRESS IN MY_ADDRESS); + + PROCEDURE C; + C1 : BOOLEAN := (C'ADDRESS IN MY_ADDRESS); + + FUNCTION D RETURN BOOLEAN; + D1 : BOOLEAN := (D'ADDRESS IN MY_ADDRESS); + + TASK E IS + END E; + E1 : BOOLEAN := (E'ADDRESS IN MY_ADDRESS); + + TASK TYPE F IS + END F; + F1 : BOOLEAN := (F'ADDRESS IN MY_ADDRESS); + + G1 : BOOLEAN; + + PACKAGE BODY B IS + BEGIN + NULL; + END B; + + PROCEDURE C IS + BEGIN + NULL; + END C; + + FUNCTION D RETURN BOOLEAN IS + BEGIN + RETURN TRUE; + END D; + + TASK BODY E IS + BEGIN + NULL; + END E; + + TASK BODY F IS + BEGIN + NULL; + END F; + + BEGIN + <> G1 := (G'ADDRESS IN MY_ADDRESS); + END; + + RESULT; + END AD7201A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7203b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7203b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7203b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7203b.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,267 ---- + -- AD7203B.ADA + + -- 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 THE PREFIX OF THE 'SIZE' ATTRIBUTE CAN BE AN OBJECT, + -- A TYPE, OR A SUBTYPE. + + -- HISTORY: + -- BCB 09/27/88 CREATED ORIGINAL TEST BY MODIFYING AND RENAMING + -- CD7203B.ADA. + + WITH SYSTEM; + WITH REPORT; USE REPORT; + PROCEDURE AD7203B IS + + TYPE I_REC IS + RECORD + I1, I2 : INTEGER; + END RECORD; + + I : INTEGER; + I_A : ARRAY (1 ..5) OF INTEGER; + I_R : I_REC; + + I_SIZE : INTEGER := I'SIZE; + I_A_SIZE : INTEGER := I_A'SIZE; + I_R_SIZE : INTEGER := I_R'SIZE; + I_A_1_SIZE : INTEGER := I_A(1)'SIZE; + I_R_I1_SIZE : INTEGER := I_R.I1'SIZE; + + TYPE FIXED IS DELTA 0.01 RANGE -1.0 .. 1.0; + TYPE FXD_REC IS + RECORD + FXD1, FXD2 : FIXED; + END RECORD; + + FXD : FIXED; + FXD_A : ARRAY (1 .. 5) OF FIXED; + FXD_R : FXD_REC; + + FXD_SIZE : INTEGER := FXD'SIZE; + FXD_A_SIZE : INTEGER := FXD_A'SIZE; + FXD_R_SIZE : INTEGER := FXD_R'SIZE; + FXD_A_1_SIZE : INTEGER := FXD_A(1)'SIZE; + FXD_R_FXD1_SIZE : INTEGER := FXD_R.FXD1'SIZE; + + TYPE FLT_REC IS + RECORD + FLT1, FLT2 : FLOAT; + END RECORD; + + FLT : FLOAT; + FLT_A : ARRAY (1 .. 5) OF FLOAT; + FLT_R : FLT_REC; + + FLT_SIZE : INTEGER := FLT'SIZE; + FLT_A_SIZE : INTEGER := FLT_A'SIZE; + FLT_R_SIZE : INTEGER := FLT_R'SIZE; + FLT_A_1_SIZE : INTEGER := FLT_A(1)'SIZE; + FLT_R_FLT1_SIZE : INTEGER := FLT_R.FLT1'SIZE; + + SUBTYPE TINY_INT IS INTEGER RANGE 0 .. 255; + TYPE TI_REC IS + RECORD + TI1, TI2 : TINY_INT; + END RECORD; + + TI : TINY_INT; + TI_A : ARRAY (1 .. 5) OF TINY_INT; + TI_R : TI_REC; + + TINY_INT_SIZE : INTEGER := TINY_INT'SIZE; + TI_SIZE : INTEGER := TI'SIZE; + TI_A_SIZE : INTEGER := TI_A'SIZE; + TI_R_SIZE : INTEGER := TI_R'SIZE; + TI_A_1_SIZE : INTEGER := TI_A(1)'SIZE; + TI_R_TI1_SIZE : INTEGER := TI_R.TI1'SIZE; + + TYPE STR IS ARRAY (TINY_INT RANGE <>) OF CHARACTER; + TYPE STR_2 IS ARRAY (1 .. 127) OF CHARACTER; + TYPE STR_REC IS + RECORD + S1, S2 : STR (TINY_INT'FIRST .. TINY_INT'LAST); + END RECORD; + + S : STR (TINY_INT'FIRST .. TINY_INT'LAST); + S_A : ARRAY (1 .. 5) OF STR (TINY_INT'FIRST .. TINY_INT'LAST); + S_R : STR_REC; + + STR_2_SIZE : INTEGER := STR_2'SIZE; + S_SIZE : INTEGER := S'SIZE; + S_A_SIZE : INTEGER := S_A'SIZE; + S_R_SIZE : INTEGER := S_R'SIZE; + S_A_1_SIZE : INTEGER := S_A(1)'SIZE; + S_R_S1_SIZE : INTEGER := S_R.S1'SIZE; + + TYPE C_REC IS + RECORD + C1, C2 : CHARACTER; + END RECORD; + + C : CHARACTER; + C_A : ARRAY (1 .. 5) OF CHARACTER; + C_R : C_REC; + + C_SIZE : INTEGER := C'SIZE; + C_A_SIZE : INTEGER := C_A'SIZE; + C_R_SIZE : INTEGER := C_R'SIZE; + C_A_1_SIZE : INTEGER := C_A(1)'SIZE; + C_R_C1_SIZE : INTEGER := C_R.C1'SIZE; + + TYPE B_REC IS + RECORD + B1, B2 : BOOLEAN; + END RECORD; + + B : BOOLEAN; + B_A : ARRAY (1 .. 5) OF BOOLEAN; + B_R : B_REC; + + B_SIZE : INTEGER := B'SIZE; + B_A_SIZE : INTEGER := B_A'SIZE; + B_R_SIZE : INTEGER := B_R'SIZE; + B_A_1_SIZE : INTEGER := B_A(1)'SIZE; + B_R_B1_SIZE : INTEGER := B_R.B1'SIZE; + + TYPE DISCR IS RANGE 1 .. 2; + TYPE DISCR_REC (D : DISCR := 1) IS + RECORD + CASE D IS + WHEN 1 => + C1_I : INTEGER; + WHEN 2 => + C2_I1 : INTEGER; + C2_I2 : INTEGER; + END CASE; + END RECORD; + + DR_UC : DISCR_REC; + DR_C : DISCR_REC (2); + DR_A : ARRAY (1 .. 5) OF DISCR_REC; + + DR_UC_SIZE : INTEGER := DR_UC'SIZE; + DR_C_SIZE : INTEGER := DR_C'SIZE; + DR_A_SIZE : INTEGER := DR_A'SIZE; + DR_UC_C1_I_SIZE : INTEGER := DR_UC.C1_I'SIZE; + DR_A_1_SIZE : INTEGER := DR_A(1)'SIZE; + + TYPE ENUM IS (E1, E2, E3, E4); + TYPE ENUM_REC IS + RECORD + E1, E2 : ENUM; + END RECORD; + + E : ENUM; + E_A : ARRAY (1 .. 5) OF ENUM; + E_R : ENUM_REC; + + E_SIZE : INTEGER := E'SIZE; + E_A_SIZE : INTEGER := E_A'SIZE; + E_R_SIZE : INTEGER := E_R'SIZE; + E_A_1_SIZE : INTEGER := E_A(1)'SIZE; + E_R_E1_SIZE : INTEGER := E_R.E1'SIZE; + + TASK TYPE TSK IS END TSK; + TYPE TSK_REC IS + RECORD + TSK1, TSK2 : TSK; + END RECORD; + + T : TSK; + T_A : ARRAY (1 .. 5) OF TSK; + T_R : TSK_REC; + + T_SIZE : INTEGER := T'SIZE; + T_A_SIZE : INTEGER := T_A'SIZE; + T_R_SIZE : INTEGER := T_R'SIZE; + T_A_1_SIZE : INTEGER := T_A(1)'SIZE; + T_R_TSK1_SIZE : INTEGER := T_R.TSK1'SIZE; + + TYPE ACC IS ACCESS INTEGER; + TYPE ACC_REC IS + RECORD + A1, A2 : ACC; + END RECORD; + + A : ACC; + A_A : ARRAY (1 .. 5) OF ACC; + A_R : ACC_REC; + + A_SIZE : INTEGER := A'SIZE; + A_A_SIZE : INTEGER := A_A'SIZE; + A_R_SIZE : INTEGER := A_R'SIZE; + A_A_1_SIZE : INTEGER := A_A(1)'SIZE; + A_R_A1_SIZE : INTEGER := A_R.A1'SIZE; + + PACKAGE PK IS + TYPE PRV IS PRIVATE; + TYPE PRV_REC IS + RECORD + P1, P2 : PRV; + END RECORD; + + TYPE LPRV IS LIMITED PRIVATE; + TYPE LPRV_REC IS + RECORD + LP1, LP2 : LPRV; + END RECORD; + PRIVATE + TYPE PRV IS NEW INTEGER; + + TYPE LPRV IS NEW INTEGER; + END PK; + USE PK; + + P : PRV; + P_A : ARRAY (1 .. 5) OF PRV; + P_R : PRV_REC; + + P_SIZE : INTEGER := P'SIZE; + P_A_SIZE : INTEGER := P_A'SIZE; + P_R_SIZE : INTEGER := P_R'SIZE; + P_A_1_SIZE : INTEGER := P_A(1)'SIZE; + P_R_P1_SIZE : INTEGER := P_R.P1'SIZE; + + LP : LPRV; + LP_A : ARRAY (1 .. 5) OF LPRV; + LP_R : LPRV_REC; + + LP_SIZE : INTEGER := LP'SIZE; + LP_A_SIZE : INTEGER := LP_A'SIZE; + LP_R_SIZE : INTEGER := LP_R'SIZE; + LP_A_1_SIZE : INTEGER := LP_A(1)'SIZE; + LP_R_LP1_SIZE : INTEGER := LP_R.LP1'SIZE; + + TASK BODY TSK IS + BEGIN + NULL; + END TSK; + + BEGIN + TEST ("AD7203B", "CHECK THAT THE PREFIX OF THE 'SIZE' ATTRIBUTE " & + "CAN BE AN OBJECT, A TYPE, OR A SUBTYPE"); + + RESULT; + END AD7203B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7205b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7205b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad7205b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad7205b.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,64 ---- + -- AD7205B.ADA + + -- 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 THE PREFIX OF THE 'STORAGE_SIZE ATTRIBUTE CAN BE AN + -- ACCESS TYPE, A TASK TYPE, A TASK OBJECT, OR A SINGLE TASK. + + -- HISTORY: + -- JET 09/22/88 CREATED ORIGINAL TEST. + + WITH REPORT; USE REPORT; + PROCEDURE AD7205B IS + + B : BOOLEAN; + + TYPE A IS ACCESS INTEGER; + TASK TYPE T; + T1 : T; + TASK T2; + + TASK BODY T IS + BEGIN + NULL; + END T; + + TASK BODY T2 IS + BEGIN + NULL; + END T2; + + BEGIN + + TEST ("AD7205B", "CHECK THAT THE PREFIX OF THE 'STORAGE_SIZE " & + "ATTRIBUTE CAN BE AN ACCESS TYPE, A TASK TYPE, " & + "A TASK OBJECT, OR A SINGLE TASK"); + + B := A'STORAGE_SIZE = T'STORAGE_SIZE; -- ACCESS AND TASK TYPES. + B := T1'STORAGE_SIZE = T2'STORAGE_SIZE; -- TASK OBJECT & SINGLE + -- TASK. + + RESULT; + + END AD7205B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad8011a.tst gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad8011a.tst *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ad8011a.tst 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ad8011a.tst 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,64 ---- + -- AD8011A.TST + + -- 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 CODE STATEMENTS ARE ALLOWED IN A PROCEDURE BODY. + + -- APPLICABILITY CRITERIA: + -- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS THAT SUPPORT + -- MACHINE CODE INSERTIONS. + + -- IF SUCH INSERTIONS ARE NOT SUPPORTED, THE "WITH MACHINE_CODE" + -- CLAUSE MUST BE REJECTED. + + + -- MACRO SUBSTITUTION: + -- IF MACHINE CODE INSERTIONS ARE SUPPORTED THEN THE MACRO + -- $MACHINE_CODE_STATEMENT MUST BE REPLACED BY A VALID CODE + -- STATEMENT. + + -- IF MACHINE CODE INSERTIONS ARE NOT SUPPORTED, THEN SUBSTITUTE + -- THE ADA NULL STATEMENT (IE: NULL;) FOR $MACHINE_CODE_STATEMENT. + + -- HISTORY: + -- DHH 08/30/88 CREATED ORIGINAL TEST. + + WITH MACHINE_CODE; -- N/A => ERROR. + USE MACHINE_CODE; + WITH REPORT; USE REPORT; + PROCEDURE AD8011A IS + + PROCEDURE CODE IS + BEGIN + $MACHINE_CODE_STATEMENT + END; + + BEGIN + TEST("AD8011A", "CHECK THAT CODE STATEMENTS ARE ALLOWED IN " & + "A PROCEDURE BODY"); + + CODE; + + RESULT; + END AD8011A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ada101a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ada101a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ada101a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ada101a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,101 ---- + -- ADA101A.ADA + + -- 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 UNCHECKED_DEALLOCATION CAN BE INSTANTIATED WITH ANY + -- TYPE AS THE OBJECT PARAMETER. + + -- HISTORY: + -- JET 09/23/88 CREATED ORIGINAL TEST. + + WITH REPORT; USE REPORT; + WITH UNCHECKED_DEALLOCATION; + PROCEDURE ADA101A IS + + TYPE ENUM IS (CURLY, MOE, LARRY); + TYPE DER IS NEW INTEGER; + SUBTYPE SUB IS CHARACTER RANGE 'A'..'Z'; + TASK TYPE TSK; + TYPE ACC IS ACCESS INTEGER; + + PACKAGE P IS + TYPE PRIV IS PRIVATE; + PRIVATE + TYPE PRIV IS RANGE -100..100; + END P; + USE P; + + TYPE ARR1 IS ARRAY (INTEGER RANGE 1..10) OF INTEGER; + TYPE ARR2 IS ARRAY (INTEGER RANGE <>) OF CHARACTER; + + TYPE REC1 IS RECORD + D, I : INTEGER; + END RECORD; + + TYPE REC2 (D : INTEGER) IS RECORD + C : CHARACTER; + END RECORD; + + TYPE INTEGERA IS ACCESS INTEGER; + TYPE FLOATA IS ACCESS FLOAT; + TYPE ENUMA IS ACCESS ENUM; + TYPE BOOLEANA IS ACCESS BOOLEAN; + TYPE CHARACTERA IS ACCESS CHARACTER; + TYPE DERA IS ACCESS DER; + TYPE SUBA IS ACCESS SUB; + TYPE TSKA IS ACCESS TSK; + TYPE ACCA IS ACCESS ACC; + TYPE PRIVA IS ACCESS PRIV; + TYPE ARR1A IS ACCESS ARR1; + TYPE ARR2A IS ACCESS ARR2; + TYPE REC1A IS ACCESS REC1; + TYPE REC2A IS ACCESS REC2; + + TASK BODY TSK IS + BEGIN + NULL; + END TSK; + + PROCEDURE RLSI IS NEW UNCHECKED_DEALLOCATION(INTEGER, INTEGERA); + PROCEDURE RLSF IS NEW UNCHECKED_DEALLOCATION(FLOAT, FLOATA); + PROCEDURE RLSE IS NEW UNCHECKED_DEALLOCATION(ENUM, ENUMA); + PROCEDURE RLSB IS NEW UNCHECKED_DEALLOCATION(BOOLEAN, BOOLEANA); + PROCEDURE RLSC IS NEW UNCHECKED_DEALLOCATION(CHARACTER,CHARACTERA); + PROCEDURE RLSD IS NEW UNCHECKED_DEALLOCATION(DER, DERA); + PROCEDURE RLSS IS NEW UNCHECKED_DEALLOCATION(SUB, SUBA); + PROCEDURE RLST IS NEW UNCHECKED_DEALLOCATION(TSK, TSKA); + PROCEDURE RLSA IS NEW UNCHECKED_DEALLOCATION(ACC, ACCA); + PROCEDURE RLSP IS NEW UNCHECKED_DEALLOCATION(PRIV, PRIVA); + PROCEDURE RLSA1 IS NEW UNCHECKED_DEALLOCATION(ARR1, ARR1A); + PROCEDURE RLSA2 IS NEW UNCHECKED_DEALLOCATION(ARR2, ARR2A); + PROCEDURE RLSR1 IS NEW UNCHECKED_DEALLOCATION(REC1, REC1A); + PROCEDURE RLSR2 IS NEW UNCHECKED_DEALLOCATION(REC2, REC2A); + + BEGIN + TEST ("ADA101A", "CHECK THAT UNCHECKED_DEALLOCATION CAN BE " & + "INSTANTIATED WITH ANY TYPE AS THE OBJECT " & + "PARAMETER"); + + RESULT; + END ADA101A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ae2113a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ae2113a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ae2113a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ae2113a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,120 ---- + -- AE2113A.ADA + + -- 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. + --* + -- CHECK THAT THE SUBPROGRAMS CREATE, OPEN, CLOSE, DELETE, RESET, MODE, + -- NAME, FORM, AND IS_OPEN ARE AVAILABLE FOR DIRECT_IO AND THAT + -- SUBPROGRAMS HAVE THE CORRECT FORMAL PARAMETER NAMES. + + -- TBN 9/30/86 + + WITH DIRECT_IO; + WITH REPORT; USE REPORT; + PROCEDURE AE2113A IS + + PACKAGE DIR_IO IS NEW DIRECT_IO (INTEGER); + USE DIR_IO; + + TEMP : FILE_TYPE; + + BEGIN + TEST ("AE2113A", "CHECK THAT THE SUBPROGRAMS CREATE, OPEN, " & + "CLOSE, DELETE, RESET, MODE, NAME, FORM, AND " & + "IS_OPEN ARE AVAILABLE FOR DIRECT_IO AND THAT " & + "SUBPROGRAMS HAVE THE CORRECT FORMAL PARAMETER " & + "NAMES"); + BEGIN + CREATE (FILE=> TEMP, MODE=> OUT_FILE, + NAME=> "AE2113A.DAT", FORM=> ""); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + RESET (FILE=> TEMP, MODE=> OUT_FILE); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + CLOSE (FILE=> TEMP); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + OPEN (FILE=> TEMP, MODE=> OUT_FILE, + NAME=> "AE2113A.DAT", FORM=> ""); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF IS_OPEN (FILE=> TEMP) THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF MODE (FILE=> TEMP) /= OUT_FILE THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF NAME (FILE=> TEMP) /= "AE2113A.DAT" THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF FORM (FILE=> TEMP) /= "" THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + DELETE (FILE=> TEMP); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + RESULT; + END AE2113A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ae2113b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ae2113b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ae2113b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ae2113b.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,120 ---- + -- AE2113B.ADA + + -- 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. + --* + -- CHECK THAT THE SUBPROGRAMS CREATE, OPEN, CLOSE, DELETE, RESET, MODE, + -- NAME, FORM, AND IS_OPEN ARE AVAILABLE FOR SEQUENTIAL_IO AND THAT + -- SUBPROGRAMS HAVE THE CORRECT FORMAL PARAMETER NAMES. + + -- TBN 9/30/86 + + WITH SEQUENTIAL_IO; + WITH REPORT; USE REPORT; + PROCEDURE AE2113B IS + + PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER); + USE SEQ_IO; + + TEMP : FILE_TYPE; + + BEGIN + TEST ("AE2113B", "CHECK THAT THE SUBPROGRAMS CREATE, OPEN, " & + "CLOSE, DELETE, RESET, MODE, NAME, FORM, AND " & + "IS_OPEN ARE AVAILABLE FOR SEQUENTIAL_IO AND " & + "THAT SUBPROGRAMS HAVE THE CORRECT FORMAL " & + "PARAMETER NAMES"); + BEGIN + CREATE (FILE=> TEMP, MODE=> OUT_FILE, + NAME=> "AE2113B.DAT", FORM=> ""); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + RESET (FILE=> TEMP, MODE=> OUT_FILE); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + CLOSE (FILE=> TEMP); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + OPEN (FILE=> TEMP, MODE=> OUT_FILE, + NAME=> "AE2113B.DAT", FORM=> ""); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF IS_OPEN (FILE=> TEMP) THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF MODE (FILE=> TEMP) /= OUT_FILE THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF NAME (FILE=> TEMP) /= "AE2113B.DAT" THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF FORM (FILE=> TEMP) /= "" THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + DELETE (FILE=> TEMP); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + RESULT; + END AE2113B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ae3002g.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ae3002g.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ae3002g.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ae3002g.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,47 ---- + -- AE3002G.ADA + + -- 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. + --* + -- CHECK THAT FILE_MODE IS VISIBLE AND HAS LITERALS IN_FILE AND + -- OUT_FILE. ASLO CHECK THAT TYPE_SET IS VISIBLE AND HAS LITERALS + -- LOWER_CASE AND UPPER_CASE. + + -- TBN 10/3/86 + + WITH TEXT_IO; USE TEXT_IO; + WITH REPORT; USE REPORT; + PROCEDURE AE3002G IS + + TEMP_FILE : FILE_TYPE; + MODE : FILE_MODE := IN_FILE; + LETTERS : TYPE_SET := LOWER_CASE; + + BEGIN + TEST ("AE3002G", "CHECK THAT FILE_MODE AND TYPE_SET ARE VISIBLE " & + "AND CHECK THEIR LITERALS"); + + MODE := OUT_FILE; + LETTERS := UPPER_CASE; + + RESULT; + END AE3002G; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ae3101a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ae3101a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ae3101a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ae3101a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,135 ---- + -- AE3101A.ADA + + -- 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 CREATE, OPEN, CLOSE, DELETE, RESET, MODE, NAME, + -- FORM, IS_OPEN, AND END_OF_FILE ARE AVAILABLE FOR TEXT FILES. + -- ALSO CHECK THAT FORMAL PARAMETER NAMES ARE CORRECT. + + -- HISTORY: + -- ABW 08/24/82 + -- SPS 09/16/82 + -- SPS 11/09/82 + -- DWC 09/24/87 REMOVED DEPENDENCE ON FILE SUPPORT. + + WITH REPORT; + USE REPORT; + WITH TEXT_IO; + USE TEXT_IO; + + PROCEDURE AE3101A IS + + FILE1 : FILE_TYPE; + + BEGIN + + TEST ("AE3101A" , "CHECK THAT CREATE, OPEN, DELETE, " & + "RESET, MODE, NAME, FORM, IS_OPEN, " & + "AND END_OF_FILE ARE AVAILABLE " & + "FOR TEXT FILE"); + + BEGIN + CREATE (FILE => FILE1, + MODE => OUT_FILE, + NAME => LEGAL_FILE_NAME, + FORM => ""); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + RESET (FILE => FILE1, MODE => IN_FILE); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + CLOSE (FILE => FILE1); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + OPEN (FILE => FILE1, + MODE => IN_FILE, + NAME => LEGAL_FILE_NAME, + FORM => ""); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + IF IS_OPEN (FILE => FILE1) THEN + NULL; + END IF; + + BEGIN + IF MODE (FILE => FILE1) /= IN_FILE THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF NAME (FILE => FILE1) /= LEGAL_FILE_NAME THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF FORM (FILE => FILE1) /= "" THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + IF END_OF_FILE (FILE => FILE1) THEN + NULL; + END IF; + EXCEPTION + WHEN OTHERS => + NULL; + END; + + BEGIN + DELETE (FILE => FILE1); + EXCEPTION + WHEN OTHERS => + NULL; + END; + + RESULT; + + END AE3101A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ae3702a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ae3702a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ae3702a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ae3702a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,59 ---- + -- AE3702A.ADA + + -- 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. + --* + -- CHECK THAT INTEGER_IO CAN BE INSTANTIATED FOR USER DEFINED INTEGER + -- TYPES. + + -- SPS 10/1/82 + + WITH REPORT; USE REPORT; + WITH TEXT_IO; USE TEXT_IO; + + PROCEDURE AE3702A IS + BEGIN + + TEST ("AE3702A", "CHECK THAT INTEGER_IO CAN BE INSTANTIATED FOR " & + "USER DEFINED TYPES"); + + DECLARE + TYPE I1 IS RANGE 6 .. 14; + TYPE I2 IS NEW INTEGER; + TYPE I3 IS NEW INTEGER RANGE 0 .. INTEGER'LAST; + SUBTYPE S1 IS INTEGER RANGE 6 .. 14; + SUBTYPE S2 IS INTEGER; + SUBTYPE S3 IS INTEGER RANGE 0 .. INTEGER'LAST; + + PACKAGE NIO1 IS NEW INTEGER_IO (I1); + PACKAGE NIO2 IS NEW INTEGER_IO (I2); + PACKAGE NIO3 IS NEW INTEGER_IO (I3); + PACKAGE NIO4 IS NEW INTEGER_IO (S1); + PACKAGE NIO5 IS NEW INTEGER_IO (S2); + PACKAGE NIO6 IS NEW INTEGER_IO (S3); + + BEGIN + NULL; + END; + + RESULT; + END AE3702A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ae3709a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ae3709a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/a/ae3709a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/a/ae3709a.ada 2003-10-27 11:28:49.000000000 +0000 *************** *** 0 **** --- 1,56 ---- + -- AE3709A.ADA + + -- 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. + --* + -- CHECK THE NAMES OF THE FORMAL PARAMETERS. + + -- JBG 3/30/83 + + WITH REPORT; USE REPORT; + WITH TEXT_IO; USE TEXT_IO; + + PROCEDURE AE3709A IS + + PACKAGE INT IS NEW INTEGER_IO(INTEGER); + USE INT; + FILE : FILE_TYPE; + STR : STRING(1..3); + LAST : POSITIVE; + ITEM : INTEGER; + + BEGIN + + TEST ("AE3709A", "CHECK NAMES OF FORMAL PARAMETERS"); + + IF EQUAL(2, 3) THEN + GET (FILE => FILE, ITEM => ITEM, WIDTH => 0); + GET (ITEM => ITEM, WIDTH => 0); + PUT (FILE => FILE, ITEM => ITEM, WIDTH => 4, BASE => 4); + PUT (ITEM => ITEM, WIDTH => 4, BASE => 4); + GET (FROM => STR, ITEM => ITEM, LAST => LAST); + PUT (TO => STR, ITEM => ITEM, BASE => 4); + END IF; + + RESULT; + + END AE3709A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23001a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23001a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23001a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23001a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,64 ---- + -- C23001A.ADA + + -- 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. + --* + -- CHECK THAT UPPER AND LOWER CASE LETTERS ARE EQUIVALENT IN IDENTIFIERS + -- (INCLUDING RESERVED WORDS). + + -- JRK 12/12/79 + -- JWC 6/28/85 RENAMED TO -AB + + WITH REPORT; + PROCEDURE C23001A IS + + USE REPORT; + + AN_IDENTIFIER : INTEGER := 1; + + BEGIN + TEST ("C23001A", "UPPER/LOWER CASE EQUIVALENCE IN IDENTIFIERS"); + + DECLARE + an_identifier : INTEGER := 3; + BEGIN + IF an_identifier /= AN_IDENTIFIER THEN + FAILED ("LOWER CASE NOT EQUIVALENT TO UPPER " & + "IN DECLARABLE IDENTIFIERS"); + END IF; + END; + + IF An_IdEnTIfieR /= AN_IDENTIFIER THEN + FAILED ("MIXED CASE NOT EQUIVALENT TO UPPER IN " & + "DECLARABLE IDENTIFIERS"); + END IF; + + if AN_IDENTIFIER = 1 ThEn + AN_IDENTIFIER := 2; + END IF; + IF AN_IDENTIFIER /= 2 THEN + FAILED ("LOWER AND/OR MIXED CASE NOT EQUIVALENT TO " & + "UPPER IN RESERVED WORDS"); + END IF; + + RESULT; + END C23001A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23003a.tst gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23003a.tst *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23003a.tst 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23003a.tst 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,104 ---- + -- C23003A.TST + + -- 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. + --* + -- CHECK THAT VARIABLE IDENTIFIERS CAN BE AS LONG AS THE MAXIMUM LENGTH + -- IDENTIFIER PERMITTED AND THAT ALL CHARACTERS ARE SIGNIFICANT. + + -- JRK 12/12/79 + -- JRK 1/11/80 + -- JWC 6/28/85 RENAMED TO -AB + -- KAS 12/04/95 CHANGED "INPUT LINE LENGTH" TO "LENGTH IDENTIFIER" + + WITH REPORT; + PROCEDURE C23003A IS + + USE REPORT; + + BEGIN + TEST ("C23003A", "MAXIMUM LENGTH VARIABLE IDENTIFIERS"); + + -- BIG_ID1 AND BIG_ID2 ARE TWO MAXIMUM LENGTH IDENTIFIERS THAT + -- DIFFER ONLY IN THEIR LAST CHARACTER. + + DECLARE + $BIG_ID1 + -- BIG_ID1 + : INTEGER := 1; + BEGIN + DECLARE + $BIG_ID2 + -- BIG_ID2 + : INTEGER := 2; + BEGIN + + IF + $BIG_ID1 + -- BIG_ID1 + + + $BIG_ID2 + -- BIG_ID2 + /= 3 THEN + FAILED ("IDENTIFIERS AS LONG AS " & + "MAXIMUM INPUT LINE LENGTH " & + "NOT PERMITTED OR NOT " & + "DISTINGUISHED BY DISTINCT " & + "SUFFIXES"); + END IF; + + END; + END; + + -- BIG_ID3 AND BIG_ID4 ARE TWO MAXIMUM LENGTH IDENTIFIERS THAT + -- DIFFER ONLY IN THEIR MIDDLE CHARACTER. + + DECLARE + $BIG_ID3 + -- BIG_ID3 + : INTEGER := 3; + BEGIN + DECLARE + $BIG_ID4 + -- BIG_ID4 + : INTEGER := 4; + BEGIN + + IF + $BIG_ID3 + -- BIG_ID3 + + + $BIG_ID4 + -- BIG_ID4 + /= 7 THEN + FAILED ("IDENTIFIERS AS LONG AS " & + "MAXIMUM INPUT LINE LENGTH " & + "NOT PERMITTED OR NOT " & + "DISTINGUISHED BY DISTINCT " & + "MIDDLES"); + END IF; + + END; + END; + + RESULT; + END C23003A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23003b.tst gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23003b.tst *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23003b.tst 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23003b.tst 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,103 ---- + -- C23003B.TST + + -- 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. + --* + -- + -- CHECK THAT THE NAME OF A LIBRARY UNIT PACKAGE AND THE NAME OF A LIBRARY + -- SUBPROGRAM CAN BE AS LONG AS THE LONGEST IDENTIFIER ALLOWED BY + -- AN IMPLEMENTATION. + + -- JBG 5/26/85 + -- DTN 3/25/92 CONSOLIDATION OF C23003B.TST AND C23003C.TST. + -- KAS 11/04/95 CHANGE "LINE" TO "IDENTIFIER" + + PACKAGE + $BIG_ID1 + IS + A : INTEGER := 1; + END + $BIG_ID1 + ; + PACKAGE + $BIG_ID2 + IS + B : INTEGER := 2; + END + $BIG_ID2 + ; + + PROCEDURE + $BIG_ID3 + (X : OUT INTEGER) IS + BEGIN + X := 1; + END + $BIG_ID3 + ; + PROCEDURE + $BIG_ID4 + (X : OUT INTEGER) IS + BEGIN + X := 2; + END + $BIG_ID4 + ; + + WITH + $BIG_ID1 + , + $BIG_ID2 + , + $BIG_ID3 + , + $BIG_ID4 + ; + USE + $BIG_ID1 + , + $BIG_ID2 + ; + + WITH REPORT; USE REPORT; + PROCEDURE C23003B IS + X1, X2 : INTEGER := 0; + BEGIN + TEST ("C23003B", "CHECK LONGEST POSSIBLE IDENTIFIER CAN BE USED " & + "FOR LIBRARY PACKAGE AND SUBPROGRAM"); + + IF A + IDENT_INT(1) /= B THEN + FAILED ("INCORRECT PACKAGE IDENTIFICATION"); + END IF; + + + $BIG_ID3 + (X1); + $BIG_ID4 + (X2); + + IF X1 + IDENT_INT(1) /= X2 THEN + FAILED ("INCORRECT PROCEDURE IDENTIFICATION"); + END IF; + + RESULT; + END C23003B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23003g.tst gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23003g.tst *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23003g.tst 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23003g.tst 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,129 ---- + -- C23003G.TST + + -- 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. + --* + -- CHECK THAT THE NAME OF A GENERIC LIBRARY UNIT PACKAGE AND THE NAME + -- OF A GENERIC LIBRARY UNIT SUBPROGRAM CAN BE AS LONG + + -- JBG 5/26/85 + -- DTN 3/25/92 CONSOLIDATION OF C23003G.TST AND C23003H.TST. + -- KAS 12/4/95 CHANGE "LINE" TO "IDENTIFIER" + + GENERIC + PACKAGE + $BIG_ID1 + IS + A : INTEGER := 1; + END + $BIG_ID1 + ; + GENERIC + PACKAGE + $BIG_ID2 + IS + B : INTEGER := 2; + END + $BIG_ID2 + ; + + GENERIC + FUNCTION + $BIG_ID3 + RETURN INTEGER; + + FUNCTION + $BIG_ID3 + RETURN INTEGER IS + BEGIN + RETURN 3; + END + $BIG_ID3 + ; + + GENERIC + FUNCTION + $BIG_ID4 + RETURN INTEGER; + + WITH REPORT; USE REPORT; + PRAGMA ELABORATE (REPORT); + FUNCTION + $BIG_ID4 + RETURN INTEGER IS + BEGIN + RETURN IDENT_INT(4); + END + $BIG_ID4 + ; + + WITH + $BIG_ID3 + ; + PRAGMA ELABORATE ( + $BIG_ID3 + ); + FUNCTION F1 IS NEW + $BIG_ID3 + ; + + WITH + $BIG_ID1 + ; + PRAGMA ELABORATE ( + $BIG_ID1 + ); + PACKAGE C23003G_PKG IS NEW + $BIG_ID1 + ; + WITH C23003G_PKG, F1, + $BIG_ID2 + , + $BIG_ID4 + ; + USE C23003G_PKG; + WITH REPORT; USE REPORT; + PROCEDURE C23003G IS + + PACKAGE P2 IS NEW + $BIG_ID2 + ; + USE P2; + FUNCTION F2 IS NEW + $BIG_ID4 + ; + + BEGIN + TEST ("C23003G", "CHECK LONGEST POSSIBLE IDENTIFIER CAN BE USED " & + "FOR GENERIC LIBRARY PACKAGE AND SUBPROGRAM"); + + IF A + IDENT_INT(1) /= B THEN + FAILED ("INCORRECT PACKAGE IDENTIFICATION"); + END IF; + + + IF F1 + IDENT_INT(1) /= F2 THEN + FAILED ("INCORRECT FUNCTION IDENTIFICATION"); + END IF; + + RESULT; + END C23003G; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23003i.tst gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23003i.tst *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23003i.tst 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23003i.tst 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,71 ---- + -- C23003I.TST + + -- 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. + --* + -- CHECK THAT THE LONGEST POSSIBLE IDENTIFIER CAN BE THE NAME OF A + -- LIBRARY PACKAGE CREATED BY A GENERIC INSTANTIATION. + + -- JBG 5/26/85 + -- DTN 3/25/92 DELETED TEST OF TWO MAXIMUM LENGTH PACKAGE NAMES THAT + -- DIFFER ONLY IN THEIR MIDDLE CHARACTER. + + GENERIC + C : INTEGER; + PACKAGE C23003I_PKG IS + A : INTEGER := C; + END C23003I_PKG; + + WITH C23003I_PKG; + PRAGMA ELABORATE (C23003I_PKG); + PACKAGE + $BIG_ID1 + IS NEW C23003I_PKG (1); + + WITH REPORT; USE REPORT; + WITH C23003I_PKG; + PRAGMA ELABORATE (REPORT, C23003I_PKG); + PACKAGE + $BIG_ID2 + IS NEW C23003I_PKG (IDENT_INT(2)); + + WITH + $BIG_ID1 + , + $BIG_ID2 + ; + WITH REPORT; USE REPORT; + PROCEDURE C23003I IS + BEGIN + TEST ("C23003I", "CHECK THAT LONGEST POSSIBLE IDENTIFIER CAN BE " & + "USED FOR A LIBRARY PACKAGE INSTANTIATION"); + + IF + $BIG_ID1 + .A + IDENT_INT(1) /= + $BIG_ID2 + .A THEN + FAILED ("INCORRECT PACKAGE IDENTIFICATION"); + END IF; + + RESULT; + END C23003I; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23006a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23006a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23006a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23006a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,48 ---- + -- C23006A.ADA + + -- 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. + --* + -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN IDENTIFIERS. + + -- JRK 12/12/79 + -- JBG 5/25/85 + + WITH REPORT; USE REPORT; + PROCEDURE C23006A IS + + AN_IDENTIFIER : INTEGER := 1; + + BEGIN + TEST ("C23006A", "UNDERSCORES ARE SIGNFICANT IN IDENTIFERS"); + + DECLARE + ANIDENTIFIER : INTEGER := 3; + BEGIN + IF ANIDENTIFIER = AN_IDENTIFIER THEN + FAILED ("UNDERSCORE IGNORED " & + "IN DECLARABLE IDENTIFIERS"); + END IF; + END; + + RESULT; + END C23006A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23006b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23006b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23006b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23006b.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,63 ---- + -- C23006B.ADA + + -- 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. + --* + -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN LIBRARY PACKAGE IDENTIFIERS + + -- JBG 5/26/85 + -- PWN 5/25/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL. + + PACKAGE C23006B_PKG IS + A : INTEGER := 1; + END C23006B_PKG; + + PACKAGE C23006BPKG IS + D : INTEGER := 4; + PROCEDURE REQUIRE_BODY; + END C23006BPKG; + + WITH REPORT; USE REPORT; + PRAGMA ELABORATE (REPORT); + PACKAGE BODY C23006BPKG IS + PROCEDURE REQUIRE_BODY IS + BEGIN + NULL; + END; + BEGIN + D := IDENT_INT (5); + END C23006BPKG; + + WITH C23006BPKG, C23006B_PKG; + USE C23006BPKG, C23006B_PKG; + WITH REPORT; USE REPORT; + PROCEDURE C23006B IS + BEGIN + TEST ("C23006B", "CHECK UNDERSCORES ARE SIGNIFICANT " & + "FOR LIBRARY PACKAGE IDENTIFIERS"); + + IF A + IDENT_INT(4) /= D THEN + FAILED ("INCORRECT PACKAGE IDENTIFICATION"); + END IF; + + RESULT; + END C23006B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23006c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23006c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23006c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23006c.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,75 ---- + -- C23006C.ADA + + -- 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. + --* + -- CHECK THAT UNDERSCORES ARE SIGNFICANT IN NAMES OF LIBRARY + -- SUBPROGRAMS. + + -- JBG 5/26/85 + + PROCEDURE C23006C_PROC (X : OUT INTEGER) IS + BEGIN + X := 1; + END C23006C_PROC; + + PROCEDURE C23006CPROC (X : OUT INTEGER); + + PROCEDURE C23006CPROC (X : OUT INTEGER) IS + BEGIN + X := 2; + END C23006CPROC; + + FUNCTION C23006C_FUNC RETURN INTEGER IS + BEGIN + RETURN 3; + END C23006C_FUNC; + + FUNCTION C23006CFUNC RETURN INTEGER; + + WITH REPORT; USE REPORT; + PRAGMA ELABORATE (REPORT); + FUNCTION C23006CFUNC RETURN INTEGER IS + BEGIN + RETURN IDENT_INT(4); + END C23006CFUNC; + + WITH C23006C_PROC, C23006CPROC, C23006C_FUNC, C23006CFUNC; + WITH REPORT; USE REPORT; + PROCEDURE C23006C IS + X1, X2 : INTEGER; + BEGIN + TEST ("C23006C", "CHECK UNDERSCORES ARE SIGNIFICANT " & + "FOR LIBRARY SUBPROGRAM"); + + C23006C_PROC (X1); + C23006CPROC (X2); + IF X1 + IDENT_INT(1) /= X2 THEN + FAILED ("INCORRECT PROCEDURE IDENTIFICATION"); + END IF; + + IF C23006C_FUNC + IDENT_INT(1) /= C23006CFUNC THEN + FAILED ("INCORRECT FUNCTION IDENTIFICATION"); + END IF; + + RESULT; + END C23006C; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23006d.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23006d.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23006d.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23006d.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,74 ---- + -- C23006D.ADA + + -- 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. + --* + -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN THE NAMES OF GENERIC + -- LIBRARY PACKAGES + + -- JBG 5/26/85 + -- PWN 5/25/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL. + + GENERIC + PACKAGE C23006D_PKG IS + A : INTEGER := 1; + END C23006D_PKG; + + GENERIC + PACKAGE C23006DPKG IS + D : INTEGER := 2; + PROCEDURE REQUIRE_BODY; + END C23006DPKG; + + WITH REPORT; USE REPORT; + PRAGMA ELABORATE (REPORT); + PACKAGE BODY C23006DPKG IS + PROCEDURE REQUIRE_BODY IS + BEGIN + NULL; + END; + BEGIN + D := IDENT_INT (5); + END C23006DPKG; + + WITH C23006D_PKG; + PRAGMA ELABORATE (C23006D_PKG); + PACKAGE C23006D_INST IS NEW C23006D_PKG; + + WITH C23006DPKG, C23006D_INST; + USE C23006D_INST; + WITH REPORT; USE REPORT; + PROCEDURE C23006D IS + + PACKAGE P2 IS NEW C23006DPKG; + USE P2; + + BEGIN + TEST ("C23006D", "CHECK UNDERSCORES ARE SIGNIFICANT " & + "FOR GENERIC LIBRARY PACKAGE IDENTIFIERS"); + + IF A + IDENT_INT(4) /= D THEN + FAILED ("INCORRECT PACKAGE IDENTIFICATION - 1"); + END IF; + + RESULT; + END C23006D; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23006e.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23006e.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23006e.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23006e.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,95 ---- + -- C23006E.ADA + + -- 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. + --* + -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN THE NAMES OF GENERIC + -- LIBRARY UNIT SUBPROGRAMS. + + -- JBG 5/26/85 + + GENERIC + PROCEDURE C23006E_PROC (X : OUT INTEGER); + + PROCEDURE C23006E_PROC (X : OUT INTEGER) IS + BEGIN + X := 1; + END C23006E_PROC; + + GENERIC + PROCEDURE C230063PROC (X : OUT INTEGER); + + PROCEDURE C230063PROC (X : OUT INTEGER) IS + BEGIN + X := 2; + END C230063PROC; + + GENERIC + FUNCTION C23006E_GFUNC RETURN INTEGER; + + FUNCTION C23006E_GFUNC RETURN INTEGER IS + BEGIN + RETURN 3; + END C23006E_GFUNC; + + GENERIC + FUNCTION C23006EGFUNC RETURN INTEGER; + + WITH REPORT; USE REPORT; + PRAGMA ELABORATE (REPORT); + FUNCTION C23006EGFUNC RETURN INTEGER IS + BEGIN + RETURN IDENT_INT(4); + END C23006EGFUNC; + + WITH C23006E_PROC; + PRAGMA ELABORATE (C23006E_PROC); + PROCEDURE P1 IS NEW C23006E_PROC; + + WITH C23006E_GFUNC; + PRAGMA ELABORATE (C23006E_GFUNC); + FUNCTION F1 IS NEW C23006E_GFUNC; + + WITH P1, F1, C230063PROC, C23006EGFUNC; + WITH REPORT; USE REPORT; + PROCEDURE C23006E IS + + X1, X2 : INTEGER; + PROCEDURE P2 IS NEW C230063PROC; + FUNCTION F2 IS NEW C23006EGFUNC; + + BEGIN + TEST ("C23006E", "CHECK UNDERSCORES ARE SIGNIFICANT " & + "FOR GENERIC LIBRARY SUBPROGRAM IDENTIFIERS"); + + P1 (X1); + P2 (X2); + IF X1 + IDENT_INT(1) /= X2 THEN + FAILED ("INCORRECT PROCEDURE IDENTIFICATION"); + END IF; + + IF F1 + IDENT_INT(1) /= F2 THEN + FAILED ("INCORRECT FUNCTION IDENTIFICATION"); + END IF; + + RESULT; + END C23006E; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23006f.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23006f.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23006f.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23006f.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,57 ---- + -- C23006F.ADA + + -- 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. + --* + -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN LIBRARY PACKAGE NAMES + -- CREATED BY A GENERIC INSTANTIATION. + + -- JBG 5/26/85 + + GENERIC + C : INTEGER; + PACKAGE C23006F_PKG IS + A : INTEGER := C; + END C23006F_PKG; + + WITH C23006F_PKG; + PRAGMA ELABORATE (C23006F_PKG); + PACKAGE C23006F_INST IS NEW C23006F_PKG (1); + + WITH REPORT; USE REPORT; + WITH C23006F_PKG; + PRAGMA ELABORATE (REPORT, C23006F_PKG); + PACKAGE C23006FINST IS NEW C23006F_PKG (IDENT_INT(2)); + + WITH C23006F_INST, C23006FINST; + WITH REPORT; USE REPORT; + PROCEDURE C23006F IS + BEGIN + TEST ("C23006F", "CHECK THAT UNDERSCORES ARE SIGNIFICANT IN " & + "NAMES USED FOR A LIBRARY PACKAGE INSTANTIATION"); + + IF C23006F_INST.A + IDENT_INT(1) /= C23006FINST.A THEN + FAILED ("INCORRECT PACKAGE IDENTIFICATION - 1"); + END IF; + + RESULT; + END C23006F; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23006g.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23006g.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c23006g.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c23006g.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,86 ---- + -- C23006G.ADA + + -- 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. + --* + -- CHECK THAT UNDERSCORES ARE SIGNIFICANT IN LIBRARY SUBPROGRAM NAMES + -- CREATED BY A GENERIC INSTANTIATION. + + -- JBG 5/26/85 + + GENERIC + C : INTEGER; + PROCEDURE C23006G_PROC (X : OUT INTEGER); + + PROCEDURE C23006G_PROC (X : OUT INTEGER) IS + BEGIN + X := C; + END C23006G_PROC; + + GENERIC + C : INTEGER; + FUNCTION C23006G_FUNC RETURN INTEGER; + + WITH REPORT; USE REPORT; + PRAGMA ELABORATE (REPORT); + FUNCTION C23006G_FUNC RETURN INTEGER IS + BEGIN + RETURN IDENT_INT(C); + END C23006G_FUNC; + + WITH C23006G_PROC; + PRAGMA ELABORATE (C23006G_PROC); + PROCEDURE C23006G_INSTP IS NEW C23006G_PROC (1); + + WITH REPORT; USE REPORT; + WITH C23006G_PROC; + PRAGMA ELABORATE (REPORT, C23006G_PROC); + PROCEDURE C23006GINSTP IS NEW C23006G_PROC (IDENT_INT(2)); + + WITH C23006G_FUNC; + PRAGMA ELABORATE (C23006G_FUNC); + FUNCTION C23006G_INSTF IS NEW C23006G_FUNC (3); + + WITH C23006G_FUNC; + PRAGMA ELABORATE (C23006G_FUNC); + FUNCTION C23006GINSTF IS NEW C23006G_FUNC (4); + + WITH C23006G_INSTP, C23006GINSTP, C23006G_INSTF, C23006GINSTF; + WITH REPORT; USE REPORT; + PROCEDURE C23006G IS + X1, X2 : INTEGER; + BEGIN + TEST ("C23006G", "CHECK THAT UNDERSCORES ARE SIGNFICANT IN NAMES "& + "USED FOR A LIBRARY SUBPROGRAM INSTANTIATION"); + C23006G_INSTP (X1); + C23006GINSTP (X2); + + IF X1 + IDENT_INT(1) /= X2 THEN + FAILED ("INCORRECT PROCEDURE IDENTIFICATION"); + END IF; + + IF C23006G_INSTF + IDENT_INT(1) /= C23006GINSTF THEN + FAILED ("INCORRECT FUNCTION IDENTIFICATION"); + END IF; + + RESULT; + END C23006G; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24002d.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24002d.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24002d.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24002d.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,85 ---- + -- C24002D.ADA + + -- 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. + --* + -- CHECK THAT LOWER CASE E MAY BE USED IN INTEGER LITERALS, FLOATING POINT + -- LITERALS, AND FIXED POINT LITERALS. + -- CHECK THAT THESE NUMERIC LITERALS YIELD THE CORRECT VALUES. + + -- WMC 03/16/92 CONSOLIDATION OF C24002A.ADA, C24002B.ADA, C24002C.ADA + + WITH REPORT; + + PROCEDURE C24002D IS + + USE REPORT; + + BEGIN + TEST("C24002D", "CHECK THAT LOWER CASE E WORKS IN INTEGER, " & + "FLOATING POINT, AND FIXED POINT LITERALS, " & + "AND THAT THESE NUMERIC LITERALS YIELD THE " & + "CORRECT VALUES"); + + -- Integer Literals + DECLARE + X,Y : INTEGER; + BEGIN + X := 12e1; + Y := 16#E#e1; + + IF (X /= 120) OR (Y /= 224) THEN + FAILED("INCORRECT HANDLING OF LOWER CASE E " & + "IN INTEGER LITERALS"); + END IF; + END; + + + -- Floating Point Literal + DECLARE + X : FLOAT; + BEGIN + X := 16#F.FF#e+2; + + IF (X /= 4095.0) THEN + FAILED("INCORRECT HANDLING OF LOWER CASE E " & + "IN BASED FLOATING POINT LITERALS"); + END IF; + END; + + + -- Fixed Point Literal + DECLARE + TYPE FIXED IS DELTA 0.1 RANGE 0.0 .. 300.0; + X : FIXED; + BEGIN + X := 16#F.F#e1; + + IF (X /= 255.0) THEN + FAILED("INCORRECT HANDLING OF LOWER CASE E " & + "IN BASED FIXED POINT LITERALS"); + END IF; + END; + + RESULT; + + END C24002D; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24003a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24003a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24003a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24003a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,61 ---- + -- C24003A.ADA + + -- 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. + --* + -- CHECK THAT LEADING ZEROES IN INTEGRAL PARTS OF INTEGER LITERALS + -- ARE IGNORED. + + -- JRK 12/12/79 + -- JRK 12/16/80 + -- TBN 10/16/85 RENAMED FROM C24003A.TST AND FIXED LINE LENGTH. + -- DTN 11/12/91 DELETED SUBPART (B). CHANGED EXTENSION FROM '.TST' + -- TO '.ADA'. + + WITH REPORT; + PROCEDURE C24003A IS + + USE REPORT; + + BEGIN + TEST ("C24003A", "LEADING ZEROES IN INTEGER LITERALS"); + + IF 0000000000000000000000000000000000000000247 /= 247 THEN + FAILED ("LEADING ZEROES IN INTEGER LITERALS NOT " & + "IGNORED"); + END IF; + + IF 35E00000000000000000000000000000000000000001 /= 350 THEN + FAILED ("LEADING ZEROES IN EXPONENTS NOT IGNORED"); + END IF; + + IF 000000000000000000000000000000000000000016#FF# /= 255 THEN + FAILED ("LEADING ZEROES IN BASES NOT IGNORED"); + END IF; + + IF 16#0000000000000000000000000000000000000000FF# /= 255 THEN + FAILED ("LEADING ZEROES IN BASED INTEGER LITERALS " & + "NOT IGNORED"); + END IF; + + RESULT; + END C24003A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24003b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24003b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24003b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24003b.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,77 ---- + -- C24003B.ADA + + -- 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. + --* + -- CHECK THAT LEADING ZEROES IN INTEGRAL PARTS AND TRAILING ZEROES IN + -- FRACTIONAL PARTS OF FLOATING POINT LITERALS ARE IGNORED. + + -- JRK 12/12/79 + -- JRK 12/16/80 + -- TBN 10/21/85 RENAMED FROM C24003B.TST AND FIXED LINE LENGTH. + -- DTN 11/12/91 DELETED SUBPART (B). CHANGED EXTENSION FROM '.TST' + -- TO '.ADA'. + + WITH REPORT; + PROCEDURE C24003B IS + + USE REPORT; + + FL : FLOAT := 69.0E1; + + BEGIN + TEST ("C24003B", "LEADING/TRAILING ZEROES IN " & + "FLOATING POINT LITERALS"); + + IF 000000000000000000000000000000000000000069.0E1 /= FL THEN + FAILED ("LEADING ZEROES IN INTEGRAL PART OF FLOATING " & + "POINT LITERAL NOT IGNORED"); + END IF; + + IF 69.0000000000000000000000000000000000000000E1 /= FL THEN + -- MIGHT RAISE NUMERIC_ERROR AT COMPILE-TIME. + FAILED ("TRAILING ZEROES IN FRACTIONAL PART OF " & + "FLOATING POINT LITERAL NOT IGNORED"); + END IF; + + IF 0000000000000000000000000000000000000000690.00000 /= FL THEN + FAILED ("LEADING/TRAILING ZEROES IN MANTISSA OF " & + "FLOATING POINT LITERAL NOT IGNORED"); + END IF; + + IF 69.0E00000000000000000000000000000000000000001 /= FL THEN + FAILED ("LEADING ZEROES IN EXPONENT OF FLOATING " & + "POINT LITERAL NOT IGNORED"); + END IF; + + IF 16#00000000000000000000000000000000000000002B.2#E1 /= FL THEN + FAILED ("LEADING ZEROES IN BASED FLOATING POINT " & + "LITERAL NOT IGNORED"); + END IF; + + IF 16#2B.20000000000000000000000000000000000000000#E1 /= FL THEN + FAILED ("TRAILING ZEROES IN BASED FLOATING POINT " & + "LITERAL NOT IGNORED"); + END IF; + + RESULT; + END C24003B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24003c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24003c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24003c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24003c.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,79 ---- + -- C24003C.ADA + + -- 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. + --* + -- CHECK THAT LEADING ZEROES IN INTEGRAL PARTS AND TRAILING ZEROES IN + -- FRACTIONAL PARTS OF FIXED POINT LITERALS ARE IGNORED. + + -- JRK 12/12/79 + -- JRK 12/16/80 + -- TBN 10/21/85 RENAMED FROM C24003C.TST AND FIXED LINE LENGTH. + -- DTN 11/12/91 DELETED SUBPART (B). CHANGED EXTENSION FROM '.TST' + -- TO '.ADA'. + + WITH REPORT; + PROCEDURE C24003C IS + + USE REPORT; + + TYPE FIXED IS DELTA 1.0 RANGE 0.0 .. 1000.0; + FX : FIXED := 69.0E1; + + BEGIN + + TEST ("C24003C", "LEADING/TRAILING ZEROES IN " & + "FIXED POINT LITERALS"); + + IF 000000000000000000000000000000000000000069.0E1 /= FX THEN + FAILED ("LEADING ZEROES IN INTEGRAL PART OF FIXED " & + "POINT LITERAL NOT IGNORED"); + END IF; + + IF 69.0000000000000000000000000000000000000000E1 /= FX THEN + -- MIGHT RAISE NUMERIC_ERROR AT COMPILE-TIME. + FAILED ("TRAILING ZEROES IN FRACTIONAL PART OF " & + "FIXED POINT LITERAL NOT IGNORED"); + END IF; + + IF 0000000000000000000000000000000000000000690.00000 /= FX THEN + FAILED ("LEADING/TRAILING ZEROES IN MANTISSA OF " & + "FIXED POINT LITERAL NOT IGNORED"); + END IF; + + IF 69.0E00000000000000000000000000000000000000001 /= FX THEN + FAILED ("LEADING ZEROES IN EXPONENT OF FIXED " & + "POINT LITERAL NOT IGNORED"); + END IF; + + IF 16#00000000000000000000000000000000000000002B.2#E1 /= FX THEN + FAILED ("LEADING ZEROES IN BASED FIXED POINT " & + "LITERAL NOT IGNORED"); + END IF; + + IF 16#2B.20000000000000000000000000000000000000000#E1 /= FX THEN + FAILED ("TRAILING ZEROES IN BASED FIXED POINT " & + "LITERAL NOT IGNORED"); + END IF; + + RESULT; + END C24003C; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24106a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24106a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24106a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24106a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,63 ---- + -- C24106A.ADA + + -- 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 UNDERSCORE CHARACTERS ARE PERMITTED IN ANY PART OF + -- A NON-BASED DECIMAL LITERAL. + + -- HISTORY: + -- DHH 01/19/88 CREATED ORIGINAL TEST + + WITH REPORT; USE REPORT; + + PROCEDURE C24106A IS + + BEGIN + TEST("C24106A", "CHECK THAT UNDERSCORE CHARACTERS " & + "ARE PERMITTED IN ANY PART OF " & + "A NON-BASED DECIMAL LITERAL"); + + IF 1.2_3_4_5_6 /= 1.23456 THEN + FAILED("UNDERSCORES NOT PERMITTED IN FRACTIONAL PART " & + "OF A NON_BASED LITERAL"); + END IF; + IF 1_2_3_4_5.6 /= 12345.6 THEN + FAILED("UNDERSCORES NOT PERMITTED IN INTEGRAL PART " & + "OF A NON_BASED LITERAL"); + END IF; + IF 0.12E1_2 /= 0.12E12 THEN + FAILED("UNDERSCORES NOT PERMITTED IN EXPONENT PART " & + "OF A NON_BASED LITERAL"); + END IF; + IF 1_2_3_4_5 /= 12345 THEN + FAILED("UNDERSCORES NOT PERMITTED IN INTEGRAL PART " & + "OF A NON_BASED LITERAL INTEGER"); + END IF; + IF 0E1_0 /= 0 THEN + FAILED("UNDERSCORES NOT PERMITTED IN EXPONENT PART " & + "OF A NON_BASED LITERAL INTEGER"); + END IF; + + RESULT; + END C24106A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24202d.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24202d.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24202d.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24202d.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,73 ---- + -- C24202D.ADA + + -- 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. + --* + -- CHECK THAT NON-CONSECUTIVE UNDERSCORES ARE PERMITTED + -- IN EVERY PART OF BASED INTEGER, FLOATING POINT, AND FIXED POINT LITERALS. + + -- WMC 03/16/92 CONSOLIDATION OF C24202A.ADA, C24202B.ADA, C24202C.ADA + + WITH REPORT; + + PROCEDURE C24202D IS + + USE REPORT; + + TYPE FIXED1 IS DELTA 2.0**(-6) RANGE 0.0 .. 10.0; + + I1, I2 : INTEGER; + F1, F2, F3 : FLOAT; + F4, F5 : FIXED1; + + BEGIN + TEST("C24202D", "UNDERSCORES ALLOWED IN NUMERIC LITERALS"); + + I1 := 12_3; + I2 := 16#D#E0_1; + + IF (I1 /= 123) OR (I2 /= 16#D#E01) THEN + FAILED("UNDERSCORES IN INTEGER LITERALS NOT HANDLED CORRECTLY"); + END IF; + + + F1 := 1.2_5E1; + F2 := 8#1_3.5#; + F3 := 8#3.4#E1_1; + + IF (F1 /= 1.25E1) OR (F2 /= 8#13.5#) OR (F3 /= 8#3.4#E11) THEN + FAILED("UNDERSCORES IN FLOATING POINT LITERALS NOT " & + "HANDLED CORRECTLY"); + END IF; + + + F4 := 1_6#1.A#; + F5 := 8#2.3_7#; + + IF (F4 /= 16#1.A#) OR (F5 /= 8#2.37#) THEN + FAILED("UNDERSCORES IN FIXED POINT LITERALS NOT " & + "HANDLED CORRECTLY"); + END IF; + + RESULT; + + END C24202D; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24203a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24203a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24203a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24203a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,110 ---- + -- C24203A.ADA + + -- 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. + --* + -- CHECK THAT BASED INTEGER LITERALS WITH BASES 2 THROUGH 16 ALL + -- YIELD CORRECT VALUES. + + -- JRK 12/12/79 + -- JRK 10/27/80 + -- JWC 6/28/85 RENAMED FROM C24103A.ADA + + WITH REPORT; + PROCEDURE C24203A IS + + USE REPORT; + + I : INTEGER := 200; + + BEGIN + TEST ("C24203A", "VALUES OF BASED INTEGER LITERALS"); + + IF 2#11# /= 3 THEN + FAILED ("INCORRECT VALUE FOR BASE 2 INTEGER"); + END IF; + + IF 3#22# /= 8 THEN + FAILED ("INCORRECT VALUE FOR BASE 3 INTEGER"); + END IF; + + IF 4#33# /= 15 THEN + FAILED ("INCORRECT VALUE FOR BASE 4 INTEGER"); + END IF; + + IF 5#44# /= 24 THEN + FAILED ("INCORRECT VALUE FOR BASE 5 INTEGER"); + END IF; + + IF 6#55# /= 35 THEN + FAILED ("INCORRECT VALUE FOR BASE 6 INTEGER"); + END IF; + + IF 7#66# /= 48 THEN + FAILED ("INCORRECT VALUE FOR BASE 7 INTEGER"); + END IF; + + IF 8#77# /= 63 THEN + FAILED ("INCORRECT VALUE FOR BASE 8 INTEGER"); + END IF; + + IF 9#88# /= 80 THEN + FAILED ("INCORRECT VALUE FOR BASE 9 INTEGER"); + END IF; + + IF 10#99# /= 99 THEN + FAILED ("INCORRECT VALUE FOR BASE 10 INTEGER"); + END IF; + + IF 11#AA# /= 120 THEN + FAILED ("INCORRECT VALUE FOR BASE 11 INTEGER"); + END IF; + + IF 12#BB# /= 143 THEN + FAILED ("INCORRECT VALUE FOR BASE 12 INTEGER"); + END IF; + + IF 13#CC# /= 168 THEN + FAILED ("INCORRECT VALUE FOR BASE 13 INTEGER"); + END IF; + + IF 14#DD# /= 195 THEN + FAILED ("INCORRECT VALUE FOR BASE 14 INTEGER"); + END IF; + + IF 15#EE# /= 224 THEN + FAILED ("INCORRECT VALUE FOR BASE 15 INTEGER"); + END IF; + + IF 16#FF# /= 255 THEN + FAILED ("INCORRECT VALUE FOR BASE 16 INTEGER"); + END IF; + + ---------------------------------------- + + IF 7#66#E1 /= 336 THEN + FAILED ("INCORRECT VALUE FOR BASE 7 INTEGER " & + "WITH EXPONENT"); + END IF; + + RESULT; + END C24203A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24203b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24203b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24203b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24203b.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,113 ---- + -- C24203B.ADA + + -- 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 BASED REAL LITERALS WITH BASES 2 THROUGH 16 ALL + -- YIELD CORRECT VALUES. + + -- THIS TEST USES MODEL NUMBERS OF DIGITS 6. + + -- HISTORY: + -- DHH 06/15/88 CREATED ORIGINAL TEST. + -- DTN 11/30/95 REMOVED CONFORMANCE CHECKS WHERE RULES RELAXED. + + WITH REPORT; USE REPORT; + PROCEDURE C24203B IS + + TYPE CHECK IS DIGITS 6; + + BEGIN + TEST("C24203B", "CHECK THAT BASED REAL LITERALS WITH BASES " & + "2 THROUGH 16 ALL YIELD CORRECT VALUES"); + + IF + 2#0.0000000000000000000000000000000000000000000000000000000000001# + /= 2.0 ** (-61) THEN + FAILED ("INCORRECT VALUE FOR BASE 2 REAL LITERAL"); + END IF; + + IF 3#0.00000000001# < + ((2.0 ** (-18)) + (251558.0 * (2.0 ** (-37)))) OR + 3#0.00000000001# > + ((2.0 ** (-18)) + (251559.0 * (2.0 ** (-37)))) THEN + FAILED ("INCORRECT VALUE FOR BASE 3 REAL LITERAL"); + END IF; + + IF 4#13333333.213# /= 32767.609375 THEN + FAILED ("INCORRECT VALUE FOR BASE 4 REAL LITERAL"); + END IF; + + IF 5#2021444.4241121# < 32749.90625 OR + 5#2021444.4241121# > 32749.921875 THEN + FAILED ("INCORRECT VALUE FOR BASE 5 REAL LITERAL"); + END IF; + + IF 6#411355.531043# /= 32759.921875 THEN + FAILED ("INCORRECT VALUE FOR BASE 6 REAL LITERAL"); + END IF; + + IF 7#164366.625344# < 32780.90625 OR + 7#164366.625344# > 32780.9375 THEN + FAILED ("INCORRECT VALUE FOR BASE 7 REAL LITERAL"); + END IF; + + IF 8#77777.07# /= 32767.109375 THEN + FAILED ("INCORRECT VALUE FOR BASE 8 REAL LITERAL"); + END IF; + + IF 9#48888.820314# < 32804.90625 OR + 9#48888.820314# > 32804.9375 THEN + FAILED ("INCORRECT VALUE FOR BASE 9 REAL LITERAL"); + END IF; + + IF 10#32767.921875# /= 32767.921875 THEN + FAILED ("INCORRECT VALUE FOR BASE 10 REAL LITERAL"); + END IF; + + IF 11#2267A.A06682# < 32757.90625 OR + 11#2267A.A06682# > 32757.921875 THEN + FAILED ("INCORRECT VALUE FOR BASE 11 REAL LITERAL"); + END IF; + + IF 12#16B5B.B09# /= 32759.921875 THEN + FAILED ("INCORRECT VALUE FOR BASE 12 REAL LITERAL"); + END IF; + + IF 13#11B9C.BB616# < 32746.90625 OR + 13#11B9C.BB616# > 32746.921875 THEN + FAILED ("INCORRECT VALUE FOR BASE 13 REAL LITERAL"); + END IF; + + IF 14#BD1D.CC98A7# /= 32759.921875 THEN + FAILED ("INCORRECT VALUE FOR BASE 14 REAL LITERAL"); + END IF; + + IF 15#3D28188D45881111111111.0# < + (((2.0 ** 21) -2.0) * (2.0 ** 63)) THEN + FAILED ("INCORRECT VALUE FOR BASE 15 REAL LITERAL"); + END IF; + + + RESULT; + END C24203B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24207a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24207a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24207a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24207a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,65 ---- + -- C24207A.ADA + + -- 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. + --* + -- CHECK THAT LETTERS IN A BASED LITERAL MAY APPEAR IN UPPER OR LOWER + -- CASE. + + -- TBN 2/28/86 + + WITH REPORT; USE REPORT; + PROCEDURE C24207A IS + + TYPE FLOAT IS DIGITS 5; + INT_1 : INTEGER := 15#AbC# ; + INT_2 : INTEGER := 15#aBc# ; + FLO_1 : FLOAT := 16#FeD.C#e1; + FLO_2 : FLOAT := 16#fEd.c#E1; + + BEGIN + TEST("C24207A", "CHECK THAT LETTERS IN A BASED LITERAL MAY " & + "APPEAR IN UPPER OR LOWER CASE"); + + IF INT_1 /= INT_2 THEN + FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 1"); + END IF; + + IF FLO_1 /= FLO_2 THEN + FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 2"); + END IF; + + INT_1 := 14#aBc#E1; + INT_2 := 14#AbC#e1; + FLO_1 := 16#CdEf.aB#E0; + FLO_2 := 16#cDeF.Ab#e0; + + IF INT_1 /= INT_2 THEN + FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 3"); + END IF; + + IF FLO_1 /= FLO_2 THEN + FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 4"); + END IF; + + RESULT; + END C24207A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24211a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24211a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c24211a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c24211a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,87 ---- + -- C24211A.ADA + + -- 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 LEGAL FORMS INVOLVING A DIGIT FOLLOWED BY A COLON ARE + -- CORRECTLY ANALYZED USING A TWO CHARACTER LOOK-AHEAD. + + -- HISTORY: + -- DHH 01/19/88 CREATED ORIGINAL TEST. + + WITH REPORT; USE REPORT; + + PROCEDURE C24211A IS + + TYPE FIXED IS DELTA 0.0125 RANGE -1.0 .. 100.0; + + A : INTEGER RANGE 0 .. 2:10::= 1; + B : INTEGER RANGE 0 .. 2#10#:= 1; + X : FIXED RANGE 0.0 .. 16:3.0::= 1.0; + Y : FIXED RANGE 0.0 .. 16#3.0#:= 1.0; + IN2 : INTEGER; + BOOL : BOOLEAN:=3:10:=3:10:; + + BEGIN + + TEST("C24211A", "CHECK THAT LEGAL FORMS INVOLVING A DIGIT " & + "FOLLOWED BY A COLON ARE CORRECTLY ANALYZED " & + "USING A TWO CHARACTER LOOK-AHEAD"); + + IF IDENT_INT(A) /= B THEN + FAILED("CALCULATIONS OF BASED INTEGER LITERALS WHEN " & + "REPRESENTED BY SHARPS DO NOT MATCH CALCULATIONS " & + "OF BASED INTEGER LITERALS REPRESENTED BY COLONS"); + END IF; + A := A + 1; + + + IF EQUAL(3,3) THEN + Y := X + Y; + ELSE + Y := X - Y; + END IF; + + IF (2 * X) = Y THEN + NULL; + ELSE + FAILED("CALCULATIONS OF BASED REAL LITERALS WHEN " & + "REPRESENTED BY SHARPS DO NOT MATCH CALCULATIONS " & + "OF BASED REAL LITERALS REPRESENTED BY COLONS"); + END IF; + IF NOT BOOL THEN + FAILED("BOOLEAN VALUE BASED ON REAL LITERAL WAS CALCULATED " & + "INCORRECTLY"); + IN2:=2:10:; + ELSE + BOOL := FALSE; + IN2:=3:10:; + END IF; + IF BOOL THEN + A := A + 1; + ELSE + A := A - 1; + END IF; + + RESULT; + END C24211A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c250001.aw gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c250001.aw *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c250001.aw 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c250001.aw 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,167 ---- + -- C250001.AW + -- + -- 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 wide character literals are supported. + -- Check that wide character string literals are supported. + -- + -- TEST DESCRIPTION: + -- This test utilizes the brackets scheme for representing wide character + -- values in transportable 7 bit ASCII as proposed by Robert Dewar; + -- this test defines Wide_Character and Wide_String objects, and assigns + -- and tests several sample values. + -- + -- SPECIAL REQUIREMENTS: + -- + -- This file must be preprocessed before it can be executed as a test. + -- + -- This test requires that all occurrences of the bracket escape + -- representation for wide characters be replaced, as appropriate, with + -- the corresponding wide character as represented by the implementation. + -- + -- Characters above ASCII.Del are represented by an 8 character sequence: + -- + -- ["xxxx"] + -- + -- where the character code represented is specified by four hexadecimal + -- digits, () upper case. For example the wide character with the + -- code 16#ABCD# is represented by the eight character sequence: + -- + -- ["ABCD"] + -- + -- The following function documents the translation algorithm: + -- + -- function To_Wide( S:String ) return Wide_character is + -- Numerical : Natural := 0; + -- type Xlate is array(Character range '0'..'F') of Natural; + -- Xlation : Xlate + -- := ('0' => 0, '1' => 1, '2' => 2, '3' => 3, '4' => 4, + -- '5' => 5, '6' => 6, '7' => 7, '8' => 8, '9' => 9, + -- 'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14, + -- 'F' => 15, others => 0 ); + -- begin + -- for I in S'Range loop + -- Numerical := Numerical * 16 + Xlation(S(I)); + -- end loop; + -- return Wide_Character'Val(Numerical); -- the returned value is + -- implementation dependent + -- exception + -- when Constraint_Error => raise; + -- end To_Wide; + -- + -- + -- CHANGE HISTORY: + -- 26 OCT 95 SAIC Initial .Aversion + -- 11 APR 96 SAIC Minor robustness changes for 2.1 + -- 12 NOV 96 SAIC Changed file extension to .AW + -- + --! + + ----------------------------------------------------------------- C250001_0 + + package C250001_0 is + + -- The wide characters used in this test are sequential starting with + -- the character '["4F42"]' 16#0F42# + + Four_Eff_Four_Two : constant Wide_Character := '["4F42"]'; + + Four_Eff_4_3_Through_9 : constant Wide_String := + "["4F43"]["4F44"]["4F45"]["4F46"]["4F47"]["4F48"]["4F49"]"; + + Four_Eff_A_B : constant Wide_String := "["4F4A"]["4F4B"]"; + + end C250001_0; + + -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + + -- no package body C250001_0 is required or allowed + + ------------------------------------------------------------------- C250001 + + with Report; + with C250001_0; + with Ada.Tags; + + procedure C250001 is + use C250001_0; + + function Hex( N: Natural ) return String is + S : String := "xxxx"; + T : String := "0123456789ABCDEF"; + V : Natural := N; + begin + for I in reverse 1..4 loop + S(I) := T(V rem 16 +1); + V := V / 16; + end loop; + return S; + end Hex; + + procedure Match( Check : Wide_Character; Matching : Natural ) is + begin + if Wide_Character'Pos( Check ) /= Matching then + Report.Failed( "Didn't match for " & Hex(Matching) ); + end if; + end Match; + + type Value_List is array(Positive range <>) of Natural; + + procedure Match( Check : Wide_String; Matching : Value_List ) is + begin + if Check'Length /= Matching'Length then + Report.Failed( "Check'Length /= Matching'Length" ); + else + for I in Check'Range loop + Match( Check(I), Matching(I) ); + end loop; + end if; + end Match; + + begin -- Main test procedure. + + Report.Test ("C250001", "Check that wide character literals " & + "are supported. Check that wide character " & + "string literals are supported." ); + + Match( Four_Eff_Four_Two, 16#4F42# ); + + Match(Four_Eff_4_3_Through_9, + (16#4F43#,16#4F44#,16#4F45#,16#4F46#,16#4F47#,16#4F48#,16#4F49#) ); + + -- check catenations + + Match( Four_Eff_Four_Two & Four_Eff_Four_Two, (16#4F42#,16#4F42#) ); + + Match( Four_Eff_Four_Two & Four_Eff_A_B, (16#4F42#,16#4F4A#,16#4F4B#) ); + + Match( Four_Eff_A_B & Four_Eff_Four_Two, (16#4F4A#,16#4F4B#,16#4F42#) ); + + Match( Four_Eff_A_B & Four_Eff_A_B, + (16#4F4A#,16#4F4B#,16#4F4A#,16#4F4B#) ); + + Report.Result; + + end C250001; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c250002.aw gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c250002.aw *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c250002.aw 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c250002.aw 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,213 ---- + -- C250002.AW + -- + -- 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 characters in Latin-1 above ASCII.Del can be used in + -- identifiers, character literals and strings. + -- + -- TEST DESCRIPTION: + -- This test utilizes the brackets scheme for representing Latin-1 + -- character values in transportable 7 bit ASCII as proposed by + -- Robert Dewar; this test defines Character and String objects, + -- assigns and tests several sample values. Several Identifiers + -- used in this test also include Characters via the bracket escape + -- sequence scheme. + -- + -- Note that C250001 checks Wide_Characters and Wide_Strings. + -- + -- SPECIAL REQUIREMENTS: + -- + -- This file must be preprocessed before it can be executed as a test. + -- + -- This test requires that all occurrences of the bracket escaped + -- characters be replaced with the corresponding 8 bit character. + -- + -- Characters above ASCII.Del are represented by a 6 character sequence: + -- + -- ["xx"] + -- + -- where the character code represented is specified by two hexadecimal + -- digits () upper case. For example the Latin-1 character with the + -- code 16#AB# is represented by the six character sequence: + -- + -- ["AB"] + -- + -- None of the values used in this test should be interpreted as + -- a control character. + -- + -- The following function documents the translation algorithm: + -- + -- function To_Char( S:String ) return Character is + -- Numerical : Natural := 0; + -- type Xlate is array(Character range '0'..'F') of Natural; + -- Xlation : Xlate + -- := ('0' => 0, '1' => 1, '2' => 2, '3' => 3, '4' => 4, + -- '5' => 5, '6' => 6, '7' => 7, '8' => 8, '9' => 9, + -- 'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14, + -- 'F' => 15, others => 0 ); + -- begin + -- for I in S'Range loop + -- Numerical := Numerical * 16 + Xlation(S(I)); + -- end loop; + -- return Character'Val(Numerical); + -- end To_Char; + -- + -- + -- CHANGE HISTORY: + -- 10 JAN 96 SAIC Initial version + -- 12 NOV 96 SAIC Changed file extension to .AW + -- + --! + + ----------------------------------------------------------------- C250002_0 + + package C250002_0 is + + -- The extended characters used in this test start with + -- the character '["A1"]' 16#A1# and increase from there + + type Tagged_["C0"]_Id is tagged record + Length, Width: Natural; + end record; + + X_Char_A2 : constant Character := '["A2"]'; + + X_Char_A3_Through_A9 : constant String := + "["A3"]["A4"]["A5"]["A6"]["A7"]["A8"]["A9"]"; + + X_Char_AA_AB : constant String := "["AA"]["AB"]"; + + end C250002_0; + + -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + + -- no package body C250002_0 is required or allowed + + ----------------------------------------------------------------- C250002_X + + with Ada.Characters.Latin_1; + package C250002_["C1"] is + + type Enum is ( Item, 'A', '["AD"]', AE_["C6"]["E6"]_ae, + '["2D"]', '["FF"]' ); + + task type C2_["C2"] is + entry C2_["C3"]; + end C2_["C2"]; + + end C250002_["C1"]; + + -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + + package body C250002_["C1"] is + + task body C2_["C2"] is + begin + accept C2_["C3"]; + end C2_["C2"]; + + end C250002_["C1"]; + + ------------------------------------------------------------------- C250002 + + with Report; + with C250002_0; + with C250002_["C1"]; + + with Ada.Tags; + + procedure C250002 is + use C250002_0; + + My_Task: C250002_["C1"].C2_["C2"]; + + function Hex( N: Natural ) return String is + S : String := "xx"; + T : String := "0123456789ABCDEF"; + begin + S(1) := T(N / 16 +1); + S(2) := T(N mod 16 +1); + return S; + end Hex; + + procedure Match( Check : Character; Matching : Natural ) is + begin + if Check /= Character'Val( Matching ) then + Report.Failed( "Didn't match for " & Hex(Matching) ); + end if; + end Match; + + type Value_List is array(Positive range <>) of Natural; + + procedure Match( Check : String; Matching : Value_List ) is + begin + if Check'Length /= Matching'Length then + Report.Failed( "Check'Length /= Matching'Length" ); + else + for I in Check'Range loop + Match( Check(I), Matching(I - Check'First + Matching'First) ); + end loop; + end if; + end Match; + + TC_Count : Natural := 0; + + begin -- Main test procedure. + + Report.Test ("C250002", "Check that characters above ASCII.Del can be " & + "used in identifiers, character literals and " & + "strings" ); + + Report.Comment( Ada.Tags.Expanded_Name(Tagged_["C0"]_Id'Tag) ); + + for Specials in C250002_["C1"].Enum loop + TC_Count := TC_Count +1; + end loop; + + if TC_Count /= 6 then + Report.Failed("Expected 6 literals in Enum"); + end if; + + Match( X_Char_A2, 16#A2# ); + + Match(X_Char_A3_Through_A9, + (16#A3#,16#A4#,16#A5#,16#A6#,16#A7#,16#A8#,16#A9#) ); + + -- check catenations + + Match( X_Char_A2 & X_Char_A2, (16#A2#,16#A2#) ); + + Match( X_Char_A2 & X_Char_AA_AB, (16#A2#,16#AA#,16#AB#) ); + + Match( X_Char_AA_AB & X_Char_A2, (16#AA#,16#AB#,16#A2#) ); + + Match( X_Char_AA_AB & X_Char_AA_AB, + (16#AA#,16#AB#,16#AA#,16#AB#) ); + + My_Task.C2_["C3"]; + + Report.Result; + + end C250002; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c25001a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c25001a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c25001a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c25001a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,211 ---- + -- C25001A.ADA + + -- 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. + --* + -- CHECK THAT ALL CHARACTER LITERALS CAN BE WRITTEN. + + -- CASE A: THE BASIC CHARACTER SET. + + -- TBN 3/17/86 + + WITH REPORT; USE REPORT; + PROCEDURE C25001A IS + + BEGIN + TEST ("C25001A", "CHECK THAT EACH CHARACTER IN THE BASIC " & + "CHARACTER SET CAN BE WRITTEN"); + + IF CHARACTER'POS('A') /= 65 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'A'"); + END IF; + IF CHARACTER'POS('B') /= 66 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'B'"); + END IF; + IF CHARACTER'POS('C') /= 67 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'C'"); + END IF; + IF CHARACTER'POS('D') /= 68 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'D'"); + END IF; + IF CHARACTER'POS('E') /= 69 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'E'"); + END IF; + IF CHARACTER'POS('F') /= 70 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'F'"); + END IF; + IF CHARACTER'POS('G') /= 71 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'G'"); + END IF; + IF CHARACTER'POS('H') /= 72 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'H'"); + END IF; + IF CHARACTER'POS('I') /= 73 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'I'"); + END IF; + IF CHARACTER'POS('J') /= 74 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'J'"); + END IF; + IF CHARACTER'POS('K') /= 75 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'K'"); + END IF; + IF CHARACTER'POS('L') /= 76 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'L'"); + END IF; + IF CHARACTER'POS('M') /= 77 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'M'"); + END IF; + IF CHARACTER'POS('N') /= 78 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'N'"); + END IF; + IF CHARACTER'POS('O') /= 79 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'O'"); + END IF; + IF CHARACTER'POS('P') /= 80 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'P'"); + END IF; + IF CHARACTER'POS('Q') /= 81 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'Q'"); + END IF; + IF CHARACTER'POS('R') /= 82 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'R'"); + END IF; + IF CHARACTER'POS('S') /= 83 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'S'"); + END IF; + IF CHARACTER'POS('T') /= 84 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'T'"); + END IF; + IF CHARACTER'POS('U') /= 85 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'U'"); + END IF; + IF CHARACTER'POS('V') /= 86 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'V'"); + END IF; + IF CHARACTER'POS('W') /= 87 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'W'"); + END IF; + IF CHARACTER'POS('X') /= 88 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'X'"); + END IF; + IF CHARACTER'POS('Y') /= 89 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'Y'"); + END IF; + IF CHARACTER'POS('Z') /= 90 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'Z'"); + END IF; + + IF CHARACTER'POS('0') /= 48 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '0'"); + END IF; + IF CHARACTER'POS('1') /= 49 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '1'"); + END IF; + IF CHARACTER'POS('2') /= 50 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '2'"); + END IF; + IF CHARACTER'POS('3') /= 51 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '3'"); + END IF; + IF CHARACTER'POS('4') /= 52 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '4'"); + END IF; + IF CHARACTER'POS('5') /= 53 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '5'"); + END IF; + IF CHARACTER'POS('6') /= 54 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '6'"); + END IF; + IF CHARACTER'POS('7') /= 55 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '7'"); + END IF; + IF CHARACTER'POS('8') /= 56 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '8'"); + END IF; + IF CHARACTER'POS('9') /= 57 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '9'"); + END IF; + + IF CHARACTER'POS('"') /= 34 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '""'"); + END IF; + IF CHARACTER'POS('#') /= 35 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '#'"); + END IF; + IF CHARACTER'POS('&') /= 38 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '&'"); + END IF; + IF CHARACTER'POS(''') /= 39 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '''"); + END IF; + IF CHARACTER'POS('(') /= 40 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '('"); + END IF; + IF CHARACTER'POS(')') /= 41 THEN + FAILED ("INCORRECT POSITION NUMBER FOR ')'"); + END IF; + IF CHARACTER'POS('*') /= 42 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '*'"); + END IF; + IF CHARACTER'POS('+') /= 43 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '+'"); + END IF; + IF CHARACTER'POS(',') /= 44 THEN + FAILED ("INCORRECT POSITION NUMBER FOR ','"); + END IF; + IF CHARACTER'POS('-') /= 45 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '-'"); + END IF; + IF CHARACTER'POS('.') /= 46 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '.'"); + END IF; + IF CHARACTER'POS('/') /= 47 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '/'"); + END IF; + IF CHARACTER'POS(':') /= 58 THEN + FAILED ("INCORRECT POSITION NUMBER FOR ':'"); + END IF; + IF CHARACTER'POS(';') /= 59 THEN + FAILED ("INCORRECT POSITION NUMBER FOR ';'"); + END IF; + IF CHARACTER'POS('<') /= 60 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '<'"); + END IF; + IF CHARACTER'POS('=') /= 61 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '='"); + END IF; + IF CHARACTER'POS('>') /= 62 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '>'"); + END IF; + IF CHARACTER'POS('_') /= 95 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '_'"); + END IF; + IF CHARACTER'POS('|') /= 124 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '|'"); + END IF; + + IF CHARACTER'POS(' ') /= 32 THEN + FAILED ("INCORRECT POSITION NUMBER FOR ' '"); + END IF; + + RESULT; + END C25001A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c25001b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c25001b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c25001b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c25001b.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,160 ---- + -- C25001B.ADA + + -- 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. + --* + -- CHECK THAT ALL CHARACTER LITERALS CAN BE WRITTEN. + + -- CASE B: THE LOWER CASE LETTERS AND THE OTHER + -- SPECIAL CHARACTERS. + + -- TBN 8/1/86 + + WITH REPORT; USE REPORT; + PROCEDURE C25001B IS + + BEGIN + TEST ("C25001B", "CHECK THAT EACH CHARACTER IN THE LOWER CASE " & + "LETTERS AND THE OTHER SPECIAL CHARACTERS CAN " & + "BE WRITTEN"); + + IF CHARACTER'POS('a') /= 97 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'a'"); + END IF; + IF CHARACTER'POS('b') /= 98 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'b'"); + END IF; + IF CHARACTER'POS('c') /= 99 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'c'"); + END IF; + IF CHARACTER'POS('d') /= 100 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'd'"); + END IF; + IF CHARACTER'POS('e') /= 101 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'e'"); + END IF; + IF CHARACTER'POS('f') /= 102 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'f'"); + END IF; + IF CHARACTER'POS('g') /= 103 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'g'"); + END IF; + IF CHARACTER'POS('h') /= 104 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'h'"); + END IF; + IF CHARACTER'POS('i') /= 105 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'i'"); + END IF; + IF CHARACTER'POS('j') /= 106 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'j'"); + END IF; + IF CHARACTER'POS('k') /= 107 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'k'"); + END IF; + IF CHARACTER'POS('l') /= 108 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'l'"); + END IF; + IF CHARACTER'POS('m') /= 109 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'm'"); + END IF; + IF CHARACTER'POS('n') /= 110 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'n'"); + END IF; + IF CHARACTER'POS('o') /= 111 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'o'"); + END IF; + IF CHARACTER'POS('p') /= 112 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'p'"); + END IF; + IF CHARACTER'POS('q') /= 113 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'q'"); + END IF; + IF CHARACTER'POS('r') /= 114 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'r'"); + END IF; + IF CHARACTER'POS('s') /= 115 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 's'"); + END IF; + IF CHARACTER'POS('t') /= 116 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 't'"); + END IF; + IF CHARACTER'POS('u') /= 117 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'u'"); + END IF; + IF CHARACTER'POS('v') /= 118 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'v'"); + END IF; + IF CHARACTER'POS('w') /= 119 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'w'"); + END IF; + IF CHARACTER'POS('x') /= 120 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'x'"); + END IF; + IF CHARACTER'POS('y') /= 121 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'y'"); + END IF; + IF CHARACTER'POS('z') /= 122 THEN + FAILED ("INCORRECT POSITION NUMBER FOR 'z'"); + END IF; + + IF CHARACTER'POS('!') /= 33 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '!'"); + END IF; + IF CHARACTER'POS('$') /= 36 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '$'"); + END IF; + IF CHARACTER'POS('%') /= 37 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '%'"); + END IF; + IF CHARACTER'POS('?') /= 63 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '?'"); + END IF; + IF CHARACTER'POS('@') /= 64 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '@'"); + END IF; + IF CHARACTER'POS('[') /= 91 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '['"); + END IF; + IF CHARACTER'POS('\') /= 92 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '\'"); + END IF; + IF CHARACTER'POS(']') /= 93 THEN + FAILED ("INCORRECT POSITION NUMBER FOR ']'"); + END IF; + IF CHARACTER'POS('^') /= 94 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '^'"); + END IF; + IF CHARACTER'POS('`') /= 96 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '`'"); + END IF; + IF CHARACTER'POS('{') /= 123 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '{'"); + END IF; + IF CHARACTER'POS('}') /= 125 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '}'"); + END IF; + IF CHARACTER'POS('~') /= 126 THEN + FAILED ("INCORRECT POSITION NUMBER FOR '~'"); + END IF; + + RESULT; + END C25001B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c26006a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c26006a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c26006a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c26006a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,53 ---- + -- C26006A.ADA + + -- 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. + --* + -- CHECK THAT ALL ASCII CHARACTERS CAN APPEAR IN THE MIDDLE OF A STRING + -- (I.E., NONE ARE USED IN THE INTERNAL REPRESENTATION TO TERMINATE THE + -- STRING). + + -- JRK 12/12/79 + + WITH REPORT; + PROCEDURE C26006A IS + + USE REPORT; + + S1 : STRING (1..3) := "A 1"; + S2 : STRING (1..3) := "A 2"; + + BEGIN + TEST ("C26006A", "ALL ASCII CHARACTERS CAN APPEAR IN MIDDLE " & + "OF STRINGS"); + + FOR C IN CHARACTER'FIRST .. CHARACTER'LAST LOOP + S1 (2) := C; + S2 (2) := C; + IF S1 = S2 THEN + FAILED (CHARACTER'IMAGE(C) & " TERMINATED A " & + "STRING = COMPARISON"); + END IF; + END LOOP; + + RESULT; + END C26006A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c26008a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c26008a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c26008a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c26008a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,51 ---- + -- C26008A.ADA + + -- 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. + --* + -- CHECK THAT UPPER AND LOWER CASE LETTERS ARE DISTINCT WITHIN STRING + -- LITERALS. + + -- JRK 12/12/79 + -- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X. + + WITH REPORT; + PROCEDURE C26008A IS + + USE REPORT; + + BEGIN + TEST ("C26008A", "UPPER/LOWER CASE ARE DISTINCT IN STRING " & + "LITERALS"); + + IF CHARACTER'('a') = 'A' THEN + FAILED ("LOWER CASE NOT DISTINCT FROM UPPER IN " & + "CHARACTER LITERALS"); + END IF; + + IF STRING'("abcde") = "ABCDE" THEN + FAILED ("LOWER CASE NOT DISTINCT FROM UPPER IN " & + "STRING LITERALS"); + END IF; + + RESULT; + END C26008A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c2a001a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c2a001a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c2a001a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c2a001a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,60 ---- + -- C2A001A.ADA + + -- 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. + --* + -- CHECK THAT NON-CONSECUTIVE UNDERSCORES ARE PERMITTED + -- IN EVERY PART OF A BASED INTEGER LITERAL WHEN SHARPS + -- ARE USED INSTEAD OF COLONS. + + -- INTEGER LITERALS. + + -- DCB 1/24/80 + -- JRK 10/27/80 + -- JBG 5/28/85 + + WITH REPORT; + PROCEDURE C2A001A IS + + USE REPORT; + + I1, I2, I3, I4 : INTEGER; + + BEGIN + TEST("C2A001A", "UNDERSCORES ALLOWED IN BASED INTEGER LITERALS " & + "THAT HAVE COLONS"); + + I1 := 12_3; + I2 := 1_6:D:; + I3 := 2:1011_0101:; + I4 := 16:D:E0_1; + + IF I1 = 123 AND I2 = 16:D: AND I3 = 2:10110101: AND + I4 = 16:D:E01 THEN + NULL; + ELSE + FAILED("UNDERSCORES IN INTEGER LITERALS NOT HANDLED " & + "CORRECTLY"); + END IF; + + RESULT; + END C2A001A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c2a001b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c2a001b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c2a001b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c2a001b.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,59 ---- + -- C2A001B.ADA + + -- 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. + --* + -- CHECK THAT NON-CONSECUTIVE UNDERSCORES ARE PERMITTED + -- IN EVERY PART OF A BASED FLOATING POINT LITERAL THAT + -- USES COLONS INSTEAD OF SHARPS. + + -- DCB 04/22/80 + -- JRK 10/27/80 + -- JBG 5/28/85 + + WITH REPORT; + PROCEDURE C2A001B IS + + USE REPORT; + + F1, F2, F3, F4, F5 : FLOAT; + + BEGIN + TEST("C2A001B", "UNDERSCORES ALLOWED IN BASED FLOATING POINT " & + "LITERALS THAT HAVE COLONS"); + + F1 := 1.2_5E1; + F2 := 1_6:1.A:; + F3 := 8:1_3.5:; + F4 := 8:2.3_7:; + F5 := 8:3.4:E1_1; + + IF F1 = 1.25E1 AND F2 = 16:1.A: AND F3 = 8:13.5: AND + F4 = 8:2.37: AND F5 = 8:3.4:E11 THEN + NULL; + ELSE + FAILED("UNDERSCORES IN FLOATING POINT LITERALS NOT " & + "HANDLED CORRECTLY"); + END IF; + + RESULT; + END C2A001B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c2a001c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c2a001c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c2a001c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c2a001c.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,63 ---- + -- C2A001C.ADA + + -- 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. + --* + -- CHECK THAT NON-CONSECUTIVE UNDERSCORES ARE PERMITTED + -- IN EVERY PART OF A BASED FIXED POINT LITERAL THAT USES + -- COLONS INSTEAD OF SHARPS. + + -- DCB 04/22/80 + -- JRK 10/27/80 + -- JBG 5/28/85 + + WITH REPORT; + PROCEDURE C2A001C IS + + USE REPORT; + + TYPE FIXED1 IS DELTA 2.0**(-6) RANGE 0.0 .. 10.0; + TYPE FIXED2 IS DELTA 2.0**(-4) RANGE 0.0 .. 100.0; + + F2, F4 : FIXED1; + F1, F3, F5 : FIXED2; + + BEGIN + TEST("C2A001C", "UNDERSCORES ALLOWED IN BASED FIXED POINT " & + "LITERALS THAT USE COLONS"); + + F1 := 1.2_5E1; + F2 := 1_6:1.A:; + F3 := 8:1_3.5:; + F4 := 8:2.3_7:; + F5 := 8:3.4:E0_1; + + IF F1 = 1.25E1 AND F2 = 16:1.A: AND F3 = 8:13.5: AND + F4 = 8:2.37: AND F5 = 8:3.4:E01 THEN + NULL; + ELSE + FAILED("UNDERSCORES IN FIXED POINT LITERALS NOT " & + "HANDLED CORRECTLY"); + END IF; + + RESULT; + END C2A001C; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c2a002a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c2a002a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c2a002a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c2a002a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,111 ---- + -- C2A002A.ADA + + -- 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. + --* + -- CHECK THAT BASED INTEGER LITERALS WITH BASES 2 THROUGH 16 ALL + -- YIELD CORRECT VALUES WHEN COLONS ARE USED INSTEAD OF SHARPS. + + -- JRK 12/12/79 + -- JRK 10/27/80 + -- JBG 5/28/85 + + WITH REPORT; + PROCEDURE C2A002A IS + + USE REPORT; + + I : INTEGER := 200; + + BEGIN + TEST ("C2A002A", "VALUES OF BASED INTEGER LITERALS WITH " & + "COLONS"); + + IF 2:11: /= 3 THEN + FAILED ("INCORRECT VALUE FOR BASE 2 INTEGER"); + END IF; + + IF 3:22: /= 8 THEN + FAILED ("INCORRECT VALUE FOR BASE 3 INTEGER"); + END IF; + + IF 4:33: /= 15 THEN + FAILED ("INCORRECT VALUE FOR BASE 4 INTEGER"); + END IF; + + IF 5:44: /= 24 THEN + FAILED ("INCORRECT VALUE FOR BASE 5 INTEGER"); + END IF; + + IF 6:55: /= 35 THEN + FAILED ("INCORRECT VALUE FOR BASE 6 INTEGER"); + END IF; + + IF 7:66: /= 48 THEN + FAILED ("INCORRECT VALUE FOR BASE 7 INTEGER"); + END IF; + + IF 8:77: /= 63 THEN + FAILED ("INCORRECT VALUE FOR BASE 8 INTEGER"); + END IF; + + IF 9:88: /= 80 THEN + FAILED ("INCORRECT VALUE FOR BASE 9 INTEGER"); + END IF; + + IF 10:99: /= 99 THEN + FAILED ("INCORRECT VALUE FOR BASE 10 INTEGER"); + END IF; + + IF 11:AA: /= 120 THEN + FAILED ("INCORRECT VALUE FOR BASE 11 INTEGER"); + END IF; + + IF 12:BB: /= 143 THEN + FAILED ("INCORRECT VALUE FOR BASE 12 INTEGER"); + END IF; + + IF 13:CC: /= 168 THEN + FAILED ("INCORRECT VALUE FOR BASE 13 INTEGER"); + END IF; + + IF 14:DD: /= 195 THEN + FAILED ("INCORRECT VALUE FOR BASE 14 INTEGER"); + END IF; + + IF 15:EE: /= 224 THEN + FAILED ("INCORRECT VALUE FOR BASE 15 INTEGER"); + END IF; + + IF 16:FF: /= 255 THEN + FAILED ("INCORRECT VALUE FOR BASE 16 INTEGER"); + END IF; + + ---------------------------------------- + + IF 7:66:E1 /= 336 THEN + FAILED ("INCORRECT VALUE FOR BASE 7 INTEGER " & + "WITH EXPONENT"); + END IF; + + RESULT; + END C2A002A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c2a008a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c2a008a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c2a008a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c2a008a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,66 ---- + -- C2A008A.ADA + + -- 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. + --* + -- CHECK THAT UPPER AND LOWER CASE "E" MAY APPEAR IN BASED LITERALS, + -- WHEN USING COLONS IN PLACE OF THE SHARP SIGN. + + -- TBN 2/28/86 + + WITH REPORT; USE REPORT; + PROCEDURE C2A008A IS + + TYPE FLOAT IS DIGITS 5; + INT_1 : INTEGER := 15:A:E1; + INT_2 : INTEGER := 15:A:e1; + FLO_1 : FLOAT := 16:FD.C:E1; + FLO_2 : FLOAT := 16:FD.C:e1; + + BEGIN + TEST("C2A008A", "CHECK THAT UPPER AND LOWER CASE ""E"" MAY " & + "APPEAR IN BASED LITERALS, WHEN USING COLONS " & + "IN PLACE OF THE SHARP SIGN"); + + IF INT_1 /= INT_2 THEN + FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 1"); + END IF; + + IF FLO_1 /= FLO_2 THEN + FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 2"); + END IF; + + INT_1 := 14:BC:E1; + INT_2 := 14:BC:e1; + FLO_1 := 16:DEF.AB:E0; + FLO_2 := 16:DEF.AB:e0; + + IF INT_1 /= INT_2 THEN + FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 3"); + END IF; + + IF FLO_1 /= FLO_2 THEN + FAILED ("UPPER AND LOWER CASE LETTERS NOT ALLOWED - 4"); + END IF; + + RESULT; + END C2A008A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c2a021b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c2a021b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c2/c2a021b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c2/c2a021b.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,44 ---- + -- C2A021B.ADA + + -- 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. + --* + -- CHECK THAT A STRING LITERAL DELIMITED BY PERCENT SIGNS MUST CONTAIN A + -- DOUBLED PERCENT CHARACTER IF THE STRING VALUE IS TO CONTAIN A PERCENT + -- CHARACTER. + + -- JBG 5/25/85 + + WITH REPORT; USE REPORT; + PROCEDURE C2A021B IS + X : STRING (1..5) := %%%%%345%; + Y : STRING (1..5) := IDENT_STR ("%%345"); + BEGIN + TEST ("C2A021B", "CHECK USE OF PERCENT SIGN INSIDE STRINGS " & + "DELIMITED WITH PERCENT SIGNS"); + + IF X /= Y THEN + FAILED ("STRING LITERALS NOT EQUAL"); + END IF; + + RESULT; + END C2A021B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32001a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32001a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32001a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32001a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,152 ---- + -- C32001A.ADA + + -- 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. + --* + -- CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR SCALAR TYPES, THE + -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED + -- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE + -- INDICATION IS EVALUATED FIRST. ALSO, CHECK THAT THE EVALUATIONS + -- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS. + + -- RJW 7/16/86 + + WITH REPORT; USE REPORT; + + PROCEDURE C32001A IS + + BUMP : ARRAY (1 .. 8) OF INTEGER := (OTHERS => 0); + + FUNCTION F (I : INTEGER) RETURN INTEGER IS + BEGIN + BUMP (I) := BUMP (I) + 1; + RETURN BUMP (I); + END F; + + BEGIN + TEST ("C32001A", "CHECK THAT IN MULTIPLE OBJECT DECLARATION " & + "FOR SCALAR TYPES, THE SUBTYPE INDICATION " & + "AND THE INITIALIZATION EXPRESSIONS ARE " & + "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " & + "IS DECLARED AND THE SUBTYPE INDICATION IS " & + "EVALUATED FIRST. ALSO, CHECK THAT THE " & + "EVALUATIONS YIELD THE SAME RESULT AS A " & + "SEQUENCE OF SINGLE OBJECT DECLARATIONS" ); + + DECLARE + + TYPE DAY IS (MON, TUES, WED, THURS, FRI); + D1, D2 : DAY + RANGE MON .. DAY'VAL (F (1)) := + DAY'VAL (F (1) - 1); + CD1, CD2 : CONSTANT DAY + RANGE MON .. DAY'VAL (F (2)) := + DAY'VAL (F (2) - 1); + + I1, I2 : INTEGER RANGE 0 .. F (3) := + F (3) - 1; + CI1, CI2 : CONSTANT INTEGER RANGE 0 .. F (4) + := F (4) - 1; + + TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0; + FL1, FL2 : FLT RANGE 0.0 .. FLT (F (5)) := + FLT (F (5) - 1); + CFL1, CFL2 : CONSTANT FLT + RANGE 0.0 .. FLT (F (6)) := + FLT (F (6) - 1); + + TYPE FIX IS DELTA 1.0 RANGE -5.0 .. 5.0; + FI1, FI2 : FIX RANGE 0.0 .. FIX (F (7)) := + FIX (F (7) - 1); + CFI1, CFI2 : CONSTANT FIX + RANGE 0.0 .. FIX (F (8)) := + FIX (F (8) - 1); + + BEGIN + IF D1 /= TUES THEN + FAILED ( "D1 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF D2 /= THURS THEN + FAILED ( "D2 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF CD1 /= TUES THEN + FAILED ( "CD1 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF CD2 /= THURS THEN + FAILED ( "CD2 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF I1 /= 1 THEN + FAILED ( "I1 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF I2 /= 3 THEN + FAILED ( "I2 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF CI1 /= 1 THEN + FAILED ( "CI1 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF CI2 /= 3 THEN + FAILED ( "CI2 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF FL1 /= 1.0 THEN + FAILED ( "FL1 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF FL2 /= 3.0 THEN + FAILED ( "FL2 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF CFL1 /= 1.0 THEN + FAILED ( "CFL1 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF CFL2 /= 3.0 THEN + FAILED ( "CFL2 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF FI1 /= 1.0 THEN + FAILED ( "FI1 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF FI2 /= 3.0 THEN + FAILED ( "FI2 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF CFI1 /= 1.0 THEN + FAILED ( "CFI1 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + IF CFI2 /= 3.0 THEN + FAILED ( "CFI2 NOT INITIALIZED TO CORRECT VALUE" ); + END IF; + + END; + + RESULT; + END C32001A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32001b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32001b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32001b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32001b.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,249 ---- + -- C32001B.ADA + + -- 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 IN MULTIPLE OBJECT DECLARATIONS FOR ARRAY TYPES, THE + -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE + -- EVALUATED ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE + -- SUBTYPE INDICATION IS EVALUATED FIRST. ALSO, CHECK THAT THE + -- EVALUATIONS YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT + -- DECLARATIONS. + + -- HISTORY: + -- RJW 07/16/86 CREATED ORIGINAL TEST. + -- BCB 08/18/87 CHANGED HEADER TO STANDARD HEADER FORMAT. CHANGED + -- COMMENTS FOR S4 AND CS4 TO READ THAT THE BOUNDS ARE + -- 1 .. 6 AND THE COMPONENT TYPE ARR IS 1 .. 5. + + WITH REPORT; USE REPORT; + + PROCEDURE C32001B IS + + TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER; + + BUMP : ARRAY (1 .. 4) OF INTEGER := (0, 0, 0, 0); + + FUNCTION F (I : INTEGER) RETURN INTEGER IS + BEGIN + BUMP (I) := BUMP (I) + 1; + RETURN BUMP (I); + END F; + + BEGIN + TEST ("C32001B", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " & + "FOR ARRAY TYPES, THE SUBTYPE INDICATION " & + "AND THE INITIALIZATION EXPRESSIONS ARE " & + "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " & + "IS DECLARED AND THE SUBTYPE INDICATION IS " & + "EVALUATED FIRST. ALSO, CHECK THAT THE " & + "EVALUATIONS YIELD THE SAME RESULT AS A " & + "SEQUENCE OF SINGLE OBJECT DECLARATIONS" ); + + DECLARE + + S1, S2 : ARR (1 .. F (1)) := (OTHERS => F (1)); + CS1, CS2 : CONSTANT ARR (1 .. F (2)) := (OTHERS => F (2)); + + PROCEDURE CHECK (A, B : ARR; STR1, STR2 : STRING) IS + BEGIN + IF A'LAST /= 1 THEN + FAILED ( "INCORRECT UPPER BOUND FOR " & STR1 ); + END IF; + + IF A (1) /= 2 THEN + FAILED ( "INCORRECT INITIAL VALUE FOR " & STR1 ); + END IF; + + IF B'LAST /= 3 THEN + FAILED ( "INCORRECT UPPER BOUND FOR " & STR2 ); + END IF; + + BEGIN + IF B (1 .. 3) = (4, 5, 6) THEN + COMMENT ( STR2 & " WAS INITIALIZED TO " & + "(4, 5, 6)" ); + ELSIF B (1 .. 3) = (5, 4, 6) THEN + COMMENT ( STR2 & " WAS INITIALIZED TO " & + "(5, 4, 6)" ); + ELSIF B (1 .. 3) = (4, 6, 5) THEN + COMMENT ( STR2 & " WAS INITIALIZED TO " & + "(4, 6, 5)" ); + ELSIF B (1 .. 3) = (6, 4, 5) THEN + COMMENT ( STR2 & " WAS INITIALIZED TO " & + "(6, 4, 5)" ); + ELSIF B (1 .. 3) = (6, 5, 4) THEN + COMMENT ( STR2 & " WAS INITIALIZED TO " & + "(6, 5, 4)" ); + ELSIF B (1 .. 3) = (5, 6, 4) THEN + COMMENT ( STR2 & " WAS INITIALIZED TO " & + "(5, 6, 4)" ); + ELSE + FAILED ( STR2 & " HAS INCORRECT INITIAL " & + "VALUE" ); + END IF; + EXCEPTION + WHEN CONSTRAINT_ERROR => + FAILED ( "CONSTRAINT_ERROR RAISED - " & + STR2 ); + WHEN OTHERS => + FAILED ( "EXCEPTION RAISED - " & + STR2 ); + END; + END; + + BEGIN + CHECK (S1, S2, "S1", "S2"); + CHECK (CS1, CS2, "CS1", "CS2"); + END; + + DECLARE + + S3, S4 : ARRAY (1 .. F (3)) OF ARR (1 .. F (3)) := + (OTHERS => (OTHERS => F (3))); + + CS3, CS4 : CONSTANT ARRAY (1.. F (4)) OF + ARR (1 .. F (4)) := + (OTHERS => (OTHERS => F (4))); + BEGIN + IF S3'LAST = 1 THEN + IF S3 (1)'LAST = 2 THEN + COMMENT ( "S3 HAS BOUNDS 1 .. 1 AND " & + "COMPONENT TYPE ARR (1 .. 2)" ); + IF S3 (1)(1 .. 2) = (3, 4) THEN + COMMENT ( "S3 HAS INITIAL VALUES " & + "3 AND 4 - 1" ); + ELSIF S3 (1)(1 .. 2) = (4, 3) THEN + COMMENT ( "S3 HAS INITIAL VALUES " & + "4 AND 3 - 1" ); + ELSE + FAILED ( "S3 HAS WRONG INITIAL VALUES - 1" ); + END IF; + ELSE + FAILED ( "S3 HAS WRONG COMPONENT TYPE - 1" ); + END IF; + ELSIF S3'LAST = 2 THEN + IF S3 (1)'LAST = 1 THEN + COMMENT ( "S3 HAS BOUNDS 1 .. 2 AND " & + "COMPONENT TYPE ARR (1 .. 1)" ); + IF S3 (1) (1) = 3 AND S3 (2) (1) = 4 THEN + COMMENT ( "S3 HAS INITIAL VALUES " & + "3 AND 4 - 2" ); + ELSIF S3 (1) (1) = 4 AND S3 (2) (1) = 3 THEN + COMMENT ( "S3 HAS INITIAL VALUES " & + "4 AND 3 - 2" ); + ELSE + FAILED ( "S3 HAS WRONG INITIAL VALUES - 2" ); + END IF; + ELSE + FAILED ( "S3 HAS WRONG COMPONENT TYPE - 2" ); + END IF; + ELSE + FAILED ( "S3 HAS INCORRECT BOUNDS" ); + END IF; + + IF S4'LAST = 5 THEN + IF S4 (1)'LAST = 6 THEN + COMMENT ( "S4 HAS BOUNDS 1 .. 5 AND " & + "COMPONENT TYPE ARR (1 .. 6)" ); + ELSE + FAILED ( "S4 HAS WRONG COMPONENT TYPE - 1" ); + END IF; + ELSIF S4'LAST = 6 THEN + IF S4 (1)'FIRST = 1 AND S4 (1)'LAST = 5 THEN + COMMENT ( "S4 HAS BOUNDS 1 .. 6 AND " & + "COMPONENT TYPE ARR (1 .. 5)" ); + ELSE + FAILED ( "S4 HAS WRONG COMPONENT TYPE - 2" ); + END IF; + ELSE + FAILED ( "S4 HAS INCORRECT BOUNDS" ); + END IF; + + IF BUMP (3) /= 36 THEN + FAILED ( "FUNCTION F NOT INVOKED CORRECT NUMBER OF " & + "TIMES TO INITIALIZE S4" ); + END IF; + + IF CS3'FIRST = 1 AND CS3'LAST = 1 THEN + IF CS3 (1)'FIRST = 1 AND CS3 (1)'LAST = 2 THEN + COMMENT ( "CS3 HAS BOUNDS 1 .. 1 AND " & + "COMPONENT TYPE ARR (1 .. 2)" ); + IF CS3 (1)(1 .. 2) = (3, 4) THEN + COMMENT ( "CS3 HAS INITIAL VALUES " & + "3 AND 4 - 1" ); + ELSIF CS3 (1)(1 .. 2) = (4, 3) THEN + COMMENT ( "CS3 HAS INITIAL VALUES " & + "4 AND 3 - 1" ); + ELSE + FAILED ( "CS3 HAS WRONG INITIAL VALUES - 1" ); + END IF; + ELSE + FAILED ( "CS3 HAS WRONG COMPONENT TYPE - 1" ); + END IF; + ELSIF CS3'FIRST = 1 AND CS3'LAST = 2 THEN + IF CS3 (1)'FIRST = 1 AND CS3 (1)'LAST = 1 THEN + COMMENT ( "CS3 HAS BOUNDS 1 .. 2 AND " & + "COMPONENT TYPE ARR (1 .. 1)" ); + IF CS3 (1) (1) = 3 AND CS3 (2) (1) = 4 THEN + COMMENT ( "CS3 HAS INITIAL VALUES " & + "3 AND 4 - 2" ); + ELSIF CS3 (1) (1) = 4 AND CS3 (2) (1) = 3 THEN + COMMENT ( "CS3 HAS INITIAL VALUES " & + "4 AND 3 - 2" ); + ELSE + FAILED ( "CS3 HAS WRONG INITIAL VALUES - 2" ); + END IF; + ELSE + FAILED ( "CS3 HAS WRONG COMPONENT TYPE - 2" ); + END IF; + ELSE + FAILED ( "CS3 HAS INCORRECT BOUNDS" ); + END IF; + + IF CS4'FIRST = 1 AND CS4'LAST = 5 THEN + IF CS4 (1)'FIRST = 1 AND CS4 (1)'LAST = 6 THEN + COMMENT ( "CS4 HAS BOUNDS 1 .. 5 AND " & + "COMPONENT TYPE ARR (1 .. 6)" ); + ELSE + FAILED ( "CS4 HAS WRONG COMPONENT TYPE - 1" ); + END IF; + ELSIF CS4'FIRST = 1 AND CS4'LAST = 6 THEN + IF CS4 (1)'FIRST = 1 AND CS4 (1)'LAST = 5 THEN + COMMENT ( "CS4 HAS BOUNDS 1 .. 6 AND " & + "COMPONENT TYPE ARR (1 .. 5)" ); + ELSE + FAILED ( "CS4 HAS WRONG COMPONENT TYPE - 2" ); + END IF; + ELSE + FAILED ( "CS4 HAS INCORRECT BOUNDS" ); + END IF; + + IF BUMP (4) /= 36 THEN + FAILED ( "FUNCTION F NOT INVOKED CORRECT NUMBER OF " & + "TIMES TO INITIALIZE CS4" ); + END IF; + END; + + RESULT; + END C32001B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32001c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32001c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32001c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32001c.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,125 ---- + -- C32001C.ADA + + -- 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. + --* + -- CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR RECORD TYPES, THE + -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED + -- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE + -- INDICATION IS EVALUATED FIRST. ALSO, CHECK THAT THE EVALUATIONS + -- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS. + + -- RJW 7/16/86 + + WITH REPORT; USE REPORT; + + PROCEDURE C32001C IS + + TYPE ARR IS ARRAY (1 .. 2) OF INTEGER; + F1, G1 : ARR; + BUMP : ARR := (0, 0); + + FUNCTION F (I : INTEGER) RETURN INTEGER IS + BEGIN + BUMP (I) := BUMP(I) + 1; + F1 (I) := BUMP (I); + RETURN BUMP (I); + END F; + + FUNCTION G (I : INTEGER) RETURN INTEGER IS + BEGIN + BUMP (I) := BUMP(I) + 1; + G1 (I) := BUMP (I); + RETURN BUMP (I); + END G; + + FUNCTION H (I : INTEGER) RETURN INTEGER IS + BEGIN + BUMP (I) := BUMP(I) + 1; + RETURN BUMP (I); + END H; + + BEGIN + TEST ("C32001C", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " & + "FOR RECORD TYPES, THE SUBTYPE INDICATION " & + "AND THE INITIALIZATION EXPRESSIONS ARE " & + "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " & + "IS DECLARED AND THE SUBTYPE INDICATION IS " & + "EVALUATED FIRST. ALSO, CHECK THAT THE " & + "EVALUATIONS YIELD THE SAME RESULT AS A " & + "SEQUENCE OF SINGLE OBJECT DECLARATIONS" ); + + DECLARE + + TYPE REC (D1, D2 : INTEGER) IS + RECORD + VALUE : INTEGER; + END RECORD; + + R1, R2 : REC (F (1), G (1)) := + (F1 (1), G1 (1), VALUE => H (1)); + CR1, CR2 : CONSTANT REC (F (2), G (2)) := + (F1 (2), G1 (2), VALUE => H (2)); + + PROCEDURE CHECK + (R : REC; V1, V2, VAL : INTEGER; S : STRING) IS + BEGIN + IF R.D1 = V1 THEN + IF R.D2 = V2 THEN + COMMENT ( S & ".D1 INITIALIZED TO " & + INTEGER'IMAGE (V1) & " AND " & + S & ".D2 INITIALIZED TO " & + INTEGER'IMAGE (V2)); + ELSE + FAILED ( S & + ".D2 INITIALIZED INCORRECTLY - 1" ); + END IF; + ELSIF R.D1 = V2 THEN + IF R.D2 =V1 THEN + COMMENT ( S & ".D1 INITIALIZED TO " & + INTEGER'IMAGE (V2) & " AND " & + S & ".D2 INITIALIZED TO " & + INTEGER'IMAGE (V1)); + ELSE + FAILED ( S & + ".D2 INITIALIZED INCORRECTLY - 2" ); + END IF; + ELSE + FAILED ( S & ".D1 INITIALIZED INCORRECTLY TO " & + INTEGER'IMAGE (R.D1) ); + END IF; + + IF R.VALUE /= VAL THEN + FAILED ( S & ".VALUE INITIALIZED INCORRECTLY" ); + END IF; + END CHECK; + + BEGIN + CHECK (R1, 1, 2, 3, "R1"); + CHECK (R2, 4, 5, 6, "R2"); + + CHECK (CR1, 1, 2, 3, "CR1"); + CHECK (CR2, 4, 5, 6, "CR2"); + END; + + RESULT; + END C32001C; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32001d.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32001d.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32001d.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32001d.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,99 ---- + -- C32001D.ADA + + -- 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. + --* + -- CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR ACCESS TYPES, THE + -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED + -- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE + -- INDICATION IS EVALUATED FIRST. ALSO, CHECK THAT THE EVALUATIONS + -- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS. + + -- RJW 7/16/86 + + WITH REPORT; USE REPORT; + + PROCEDURE C32001D IS + + TYPE ARR IS ARRAY (1 .. 2) OF INTEGER; + BUMP : ARR := (0, 0); + F1 : ARR; + + FUNCTION F (I : INTEGER) RETURN INTEGER IS + BEGIN + BUMP (I) := BUMP (I) + 1; + F1 (I) := BUMP (I); + RETURN BUMP (I); + END F; + + FUNCTION G (I : INTEGER) RETURN INTEGER IS + BEGIN + BUMP (I) := BUMP (I) + 1; + RETURN BUMP (I); + END G; + + BEGIN + TEST ("C32001D", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " & + "FOR ACCESS TYPES, THE SUBTYPE INDICATION " & + "AND THE INITIALIZATION EXPRESSIONS ARE " & + "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " & + "IS DECLARED AND THE SUBTYPE INDICATION IS " & + "EVALUATED FIRST. ALSO, CHECK THAT THE " & + "EVALUATIONS YIELD THE SAME RESULT AS A " & + "SEQUENCE OF SINGLE OBJECT DECLARATIONS" ); + + DECLARE + + TYPE CELL (SIZE : INTEGER) IS + RECORD + VALUE : INTEGER; + END RECORD; + + TYPE LINK IS ACCESS CELL; + + L1, L2 : LINK (F (1)) := NEW CELL'(F1 (1), G (1)); + + CL1, CL2 : CONSTANT LINK (F (2)) := NEW CELL'(F1 (2), G (2)); + + PROCEDURE CHECK (L : LINK; V1, V2 : INTEGER; S : STRING) IS + BEGIN + IF L.SIZE /= V1 THEN + FAILED ( S & ".SIZE INITIALIZED INCORRECTLY TO " & + INTEGER'IMAGE (L.SIZE)); + END IF; + + IF L.VALUE /= V2 THEN + FAILED ( S & ".VALUE INITIALIZED INCORRECTLY TO " & + INTEGER'IMAGE (L.VALUE)); + END IF; + END CHECK; + + BEGIN + CHECK (L1, 1, 2, "L1"); + CHECK (L2, 3, 4, "L2"); + + CHECK (CL1, 1, 2, "CL1"); + CHECK (CL2, 3, 4, "CL2"); + END; + + RESULT; + END C32001D; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32001e.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32001e.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32001e.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32001e.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,253 ---- + -- C32001E.ADA + + -- 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. + --* + -- CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR PRIVATE TYPES, THE + -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED + -- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE + -- INDICATION IS EVALUATED FIRST. ALSO, CHECK THAT THE EVALUATIONS + -- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS. + + -- RJW 7/18/86 + + WITH REPORT; USE REPORT; + + PROCEDURE C32001E IS + + BUMP : ARRAY (1 .. 10) OF INTEGER := (OTHERS => 0); + G1 : ARRAY (5 .. 6) OF INTEGER; + + FUNCTION F (I : INTEGER) RETURN INTEGER IS + BEGIN + BUMP (I) := BUMP (I) + 1; + RETURN BUMP (I); + END F; + + FUNCTION G (I : INTEGER) RETURN INTEGER IS + BEGIN + BUMP (I) := BUMP (I) + 1; + G1 (I) := BUMP (I); + RETURN BUMP (I); + END G; + + BEGIN + TEST ("C32001E", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " & + "FOR PRIVATE TYPES, THE SUBTYPE INDICATION " & + "AND THE INITIALIZATION EXPRESSIONS ARE " & + "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " & + "IS DECLARED AND THE SUBTYPE INDICATION IS " & + "EVALUATED FIRST. ALSO, CHECK THAT THE " & + "EVALUATIONS YIELD THE SAME RESULT AS A " & + "SEQUENCE OF SINGLE OBJECT DECLARATIONS" ); + + DECLARE + PACKAGE PKG1 IS + TYPE PBOOL IS PRIVATE; + TYPE PINT IS PRIVATE; + TYPE PREC (D : INTEGER) IS PRIVATE; + TYPE PARR IS PRIVATE; + TYPE PACC IS PRIVATE; + + FUNCTION INIT1 (I : INTEGER) RETURN PBOOL; + FUNCTION INIT2 (I : INTEGER) RETURN PINT; + FUNCTION INIT3 (I : INTEGER) RETURN PREC; + FUNCTION INIT4 (I : INTEGER) RETURN PARR; + FUNCTION INIT5 (I : INTEGER) RETURN PACC; + + PROCEDURE CHECK1 (B : PBOOL; I : INTEGER; S : STRING); + PROCEDURE CHECK2 (I : PINT; J : INTEGER; S : STRING); + PROCEDURE CHECK3 (R : PREC; I, J : INTEGER; + S : STRING); + PROCEDURE CHECK4 (A : PARR; I, J : INTEGER; + S : STRING); + PROCEDURE CHECK5 (V : PACC; S : STRING); + PROCEDURE CHECK6 (V : PACC; S : STRING); + + PRIVATE + TYPE PBOOL IS NEW BOOLEAN; + TYPE PINT IS NEW INTEGER; + + TYPE PREC (D : INTEGER) IS + RECORD + VALUE : INTEGER; + END RECORD; + + TYPE PARR IS ARRAY (1 .. 2) OF INTEGER; + + TYPE VECTOR IS ARRAY (NATURAL RANGE <>) OF INTEGER; + TYPE PACC IS ACCESS VECTOR; + END PKG1; + + PACKAGE BODY PKG1 IS + FUNCTION INIT1 (I : INTEGER) RETURN PBOOL IS + BEGIN + RETURN PBOOL'VAL (F (I) - 1); + END INIT1; + + FUNCTION INIT2 (I : INTEGER) RETURN PINT IS + BEGIN + RETURN PINT'VAL (F (I)); + END INIT2; + + FUNCTION INIT3 (I : INTEGER) RETURN PREC IS + PR : PREC (G1 (I)) := (G1 (I), F (I)); + BEGIN + RETURN PR; + END INIT3; + + FUNCTION INIT4 (I : INTEGER) RETURN PARR IS + PA : PARR := (1 .. 2 => F (I)); + BEGIN + RETURN PA; + END INIT4; + + FUNCTION INIT5 (I : INTEGER) RETURN PACC IS + ACCV : PACC := NEW VECTOR'(1 .. F (I) => F (I)); + BEGIN + RETURN ACCV; + END INIT5; + + PROCEDURE CHECK1 (B : PBOOL; I : INTEGER; S : STRING) IS + BEGIN + IF B /= PBOOL'VAL (I) THEN + FAILED ( S & " HAS AN INCORRECT VALUE OF " & + PBOOL'IMAGE (B)); + END IF; + END CHECK1; + + PROCEDURE CHECK2 (I : PINT; J : INTEGER; S : STRING) IS + BEGIN + IF I /= PINT'VAL (J) THEN + FAILED ( S & " HAS AN INCORRECT VALUE OF " & + PINT'IMAGE (I)); + END IF; + END CHECK2; + + PROCEDURE CHECK3 (R : PREC; I, J : INTEGER; + S : STRING) IS + BEGIN + IF R.D /= I THEN + FAILED ( S & ".D HAS AN INCORRECT VALUE OF " + & INTEGER'IMAGE (R.D)); + END IF; + + IF R.VALUE /= J THEN + FAILED ( S & ".VALUE HAS AN INCORRECT " & + "VALUE OF " & + INTEGER'IMAGE (R.VALUE)); + END IF; + END CHECK3; + + PROCEDURE CHECK4 (A : PARR; I, J : INTEGER; + S : STRING) IS + BEGIN + IF A /= (I, J) AND A /= (J, I) THEN + FAILED ( S & " HAS AN INCORRECT VALUE" ); + END IF; + END CHECK4; + + PROCEDURE CHECK5 (V : PACC; S : STRING) IS + BEGIN + IF V'LAST /= 1 THEN + FAILED ( S & " HAS AN INCORRECT UPPER BOUND " + & "OF " & INTEGER'IMAGE (V'LAST)); + END IF; + + IF V (1) /= 2 THEN + FAILED ( S & " HAS AN INCORRECT COMPONENT " & + "VALUE" ); + END IF; + END CHECK5; + + PROCEDURE CHECK6 (V : PACC; S : STRING) IS + BEGIN + IF V'LAST /= 3 THEN + FAILED ( S & " HAS AN INCORRECT UPPER BOUND " + & "OF " & INTEGER'IMAGE (V'LAST)); + END IF; + + IF V.ALL = (4, 5, 6) OR V.ALL = (5, 4, 6) OR + V.ALL = (4, 6, 5) OR V.ALL = (6, 4, 5) OR + V.ALL = (5, 6, 4) OR V.ALL = (6, 5, 4) THEN + NULL; + ELSE + FAILED ( S & " HAS AN INCORRECT COMPONENT " & + "VALUE" ); + END IF; + END CHECK6; + + END PKG1; + + PACKAGE PKG2 IS END PKG2; + + PACKAGE BODY PKG2 IS + USE PKG1; + + B1, B2 : PBOOL := INIT1 (1); + CB1, CB2 : CONSTANT PBOOL := INIT1 (2); + + I1, I2 : PINT := INIT2 (3); + CI1, CI2 : CONSTANT PINT := INIT2 (4); + + R1, R2 : PREC (G (5)) := INIT3 (5); + CR1, CR2 : CONSTANT PREC (G (6)) := INIT3 (6); + + A1, A2 : PARR := INIT4 (7); + CA1, CA2 : CONSTANT PARR := INIT4 (8); + + V1, V2 : PACC := INIT5 (9); + CV1, CV2 : CONSTANT PACC := INIT5 (10); + + BEGIN + CHECK1 (B1, 0, "B1"); + CHECK1 (B2, 1, "B2"); + CHECK1 (CB1, 0, "CB1"); + CHECK1 (CB2, 1, "CB2"); + + CHECK2 (I1, 1, "I1"); + CHECK2 (I2, 2, "I2"); + CHECK2 (CI1, 1, "CI1"); + CHECK2 (CI2, 2, "CI2"); + + CHECK3 (R1, 1, 2, "R1"); + CHECK3 (R2, 3, 4, "R2"); + CHECK3 (CR1, 1, 2, "CR1"); + CHECK3 (CR2, 3, 4, "CR2"); + + CHECK4 (A1, 1, 2, "A1"); + CHECK4 (A2, 3, 4, "A2"); + CHECK4 (CA1, 1, 2, "CA1"); + CHECK4 (CA2, 3, 4, "CA2"); + + CHECK5 (V1, "V1"); + CHECK6 (V2, "V2"); + CHECK5 (CV1, "CV1"); + CHECK6 (CV2, "CV2"); + END PKG2; + + BEGIN + NULL; + END; + + RESULT; + END C32001E; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32107a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32107a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32107a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32107a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,363 ---- + -- C32107A.ADA + + -- 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. + --* + -- CHECK THAT OBJECT DECLARATIONS ARE ELABORATED IN THE ORDER OF THEIR + -- OCCURRENCE, I.E., THAT EXPRESSIONS ASSOCIATED WITH ONE DECLARATION + -- (INCLUDING DEFAULT EXPRESSIONS, IF APPROPRIATE) ARE EVALUATED BEFORE + -- ANY EXPRESSION BELONGING TO THE NEXT DECLARATION. ALSO, CHECK THAT + -- EXPRESSIONS IN THE SUBTYPE INDICATION OR THE CONSTRAINED ARRAY + -- DEFINITION ARE EVALUATED BEFORE ANY INITIALIZATION EXPRESSIONS ARE + -- EVALUATED. + + -- R.WILLIAMS 9/24/86 + + WITH REPORT; USE REPORT; + PROCEDURE C32107A IS + + BUMP : INTEGER := 0; + + ORDER_CHECK : INTEGER; + + G1, H1, I1 : INTEGER; + + FIRST_CALL : BOOLEAN := TRUE; + + TYPE ARR1 IS ARRAY (POSITIVE RANGE <>) OF INTEGER; + + TYPE ARR1_NAME IS ACCESS ARR1; + + TYPE ARR2 IS ARRAY (POSITIVE RANGE <>, POSITIVE RANGE <>) OF + INTEGER; + + TYPE REC (D : INTEGER) IS + RECORD + COMP : INTEGER; + END RECORD; + + TYPE REC_NAME IS ACCESS REC; + + FUNCTION F RETURN INTEGER IS + BEGIN + BUMP := BUMP + 1; + RETURN BUMP; + END F; + + FUNCTION G RETURN INTEGER IS + BEGIN + BUMP := BUMP + 1; + G1 := BUMP; + RETURN BUMP; + END G; + + FUNCTION H RETURN INTEGER IS + BEGIN + BUMP := BUMP + 1; + H1 := BUMP; + RETURN BUMP; + END H; + + FUNCTION I RETURN INTEGER IS + BEGIN + IF FIRST_CALL THEN + BUMP := BUMP + 1; + I1 := BUMP; + FIRST_CALL := FALSE; + END IF; + RETURN I1; + END I; + + BEGIN + TEST ( "C32107A", "CHECK THAT OBJECT DECLARATIONS ARE " & + "ELABORATED IN THE ORDER OF THEIR " & + "OCCURRENCE, I.E., THAT EXPRESSIONS " & + "ASSOCIATED WITH ONE DECLARATION (INCLUDING " & + "DEFAULT EXPRESSIONS, IF APPROPRIATE) ARE " & + "EVALUATED BEFORE ANY EXPRESSION BELONGING " & + "TO THE NEXT DECLARATION. ALSO, CHECK THAT " & + "EXPRESSIONS IN THE SUBTYPE INDICATION OR " & + "THE CONSTRAINED ARRAY DEFINITION ARE " & + "EVALUATED BEFORE ANY INITIALIZATION " & + "EXPRESSIONS ARE EVALUATED" ); + + DECLARE -- (A). + I1 : INTEGER := 10000 * F; + A1 : CONSTANT ARRAY (1 .. H) OF REC (G * 100) := + (1 .. H1 => (G1 * 100, I * 10)); + I2 : CONSTANT INTEGER := F * 1000; + BEGIN + ORDER_CHECK := I1 + I2 + A1'LAST + A1 (1).D + A1 (1).COMP; + IF ORDER_CHECK = 15243 OR ORDER_CHECK = 15342 THEN + COMMENT ( "ORDER_CHECK HAS VALUE " & + INTEGER'IMAGE (ORDER_CHECK) & " - (A)" ); + ELSE + FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & + "VALUE OF ORDER_CHECK SHOULD BE 15343 OR " & + "15242 -- ACTUAL VALUE IS " & + INTEGER'IMAGE (ORDER_CHECK) & " - (A)" ); + END IF; + END; -- (A). + + BUMP := 0; + + DECLARE -- (B). + A : ARR2 (1 .. F, 1 .. F * 10); + R : REC (G * 100) := (G1 * 100, F * 1000); + I : INTEGER RANGE 1 .. H; + S : REC (F * 10); + BEGIN + ORDER_CHECK := + A'LAST (1) + A'LAST (2) + R.D + R.COMP; + IF (H1 + S.D = 65) AND + (ORDER_CHECK = 4321 OR ORDER_CHECK = 4312) THEN + COMMENT ( "ORDER_CHECK HAS VALUE 65 " & + INTEGER'IMAGE (ORDER_CHECK) & " - (B)" ); + ELSE + FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & + "VALUE OF ORDER_CHECK SHOULD BE 65 4321 OR " & + "65 4312 -- ACTUAL VALUE IS " & + INTEGER'IMAGE (H1 + S.D) & + INTEGER'IMAGE (ORDER_CHECK) & " - (B)" ); + END IF; + END; -- (B). + + BUMP := 0; + + DECLARE -- (C). + I1 : CONSTANT INTEGER RANGE 1 .. G * 10 := F; + A1 : ARRAY (1 .. F * 100) OF INTEGER RANGE 1 .. H * 1000; + BEGIN + ORDER_CHECK := I1 + (G1 * 10) + A1'LAST + (H1 * 1000); + IF ORDER_CHECK = 4312 OR ORDER_CHECK = 3412 THEN + COMMENT ( "ORDER_CHECK HAS VALUE " & + INTEGER'IMAGE (ORDER_CHECK) & " - (C)" ); + ELSE + FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & + "VALUE OF ORDER_CHECK SHOULD BE 4312 OR " & + "3412 -- ACTUAL VALUE IS " & + INTEGER'IMAGE (ORDER_CHECK) & " - (C)" ); + END IF; + END; -- (C). + + BUMP := 0; + FIRST_CALL := TRUE; + + DECLARE -- (D). + A1 : ARRAY (1 .. G) OF REC (H * 10000) := + (1 .. G1 => (H1 * 10000, I * 100)); + R1 : CONSTANT REC := (F * 1000, F * 10); + + BEGIN + ORDER_CHECK := + A1'LAST + A1 (1).D + A1 (1).COMP + R1.D + R1.COMP; + IF ORDER_CHECK = 25341 OR ORDER_CHECK = 24351 OR + ORDER_CHECK = 15342 OR ORDER_CHECK = 14352 THEN + COMMENT ( "ORDER_CHECK HAS VALUE " & + INTEGER'IMAGE (ORDER_CHECK) & " - (D)" ); + ELSE + FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & + "VALUE OF ORDER_CHECK SHOULD BE 25341, " & + "24351, 15342 OR 14352 -- ACTUAL VALUE IS " & + INTEGER'IMAGE (ORDER_CHECK) & " - (D)" ); + END IF; + END; -- (D). + + BUMP := 0; + + DECLARE -- (E). + A1 : CONSTANT ARR1_NAME := NEW ARR1' (1 .. F => F * 10); + R1 : REC_NAME (H * 100) := NEW REC'(H1 * 100, F * 1000); + + BEGIN + ORDER_CHECK := A1.ALL'LAST + A1.ALL (1) + R1.D + R1.COMP; + IF ORDER_CHECK /= 4321 THEN + FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & + "VALUE OF ORDER_CHECK SHOULD BE 4321 " & + "-- ACTUAL VALUE IS " & + INTEGER'IMAGE (ORDER_CHECK) & " - (E)" ); + END IF; + END; -- (E). + + BUMP := 0; + FIRST_CALL := TRUE; + + DECLARE -- (F). + A1 : CONSTANT ARRAY (1 .. G) OF INTEGER RANGE 1 .. H * 100 := + (1 .. G1 => I * 10); + A2 : ARR1 (1 .. F * 1000); + BEGIN + ORDER_CHECK := + A1'LAST + (H1 * 100) + A1 (1) + A2'LAST; + IF ORDER_CHECK = 4231 OR ORDER_CHECK = 4132 THEN + COMMENT ( "ORDER_CHECK HAS VALUE " & + INTEGER'IMAGE (ORDER_CHECK) & " - (F)" ); + ELSE + FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & + "VALUE OF ORDER_CHECK SHOULD BE 4231 OR " & + "4132 -- ACTUAL VALUE IS " & + INTEGER'IMAGE (ORDER_CHECK) & " - (F)" ); + END IF; + END; -- (F). + + BUMP := 0; + + DECLARE -- (G). + A1 : ARR1_NAME (1 .. G) := NEW ARR1 (1 .. G1); + R1 : CONSTANT REC_NAME (H * 10) := + NEW REC'(H1 * 10, F * 100); + BEGIN + ORDER_CHECK := A1.ALL'LAST + R1.D + R1.COMP; + IF ORDER_CHECK /= 321 THEN + FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & + "VALUE OF ORDER_CHECK SHOULD BE 321 OR " & + "-- ACTUAL VALUE IS " & + INTEGER'IMAGE (ORDER_CHECK) & " - (G)" ); + END IF; + END; -- (G). + + BUMP := 0; + + DECLARE -- (H). + TYPE REC (D : INTEGER := F) IS + RECORD + COMP : INTEGER := F * 10; + END RECORD; + + R1 : REC; + R2 : REC (G * 100) := (G1 * 100, F * 1000); + BEGIN + ORDER_CHECK := R1.D + R1.COMP + R2.D + R2.COMP; + IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR + ORDER_CHECK = 3421 OR ORDER_CHECK = 3412 THEN + COMMENT ( "ORDER_CHECK HAS VALUE " & + INTEGER'IMAGE (ORDER_CHECK) & " - (H)" ); + ELSE + FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & + "VALUE OF ORDER_CHECK SHOULD BE 4321, " & + "4312, 3421, OR 3412 -- ACTUAL VALUE IS " & + INTEGER'IMAGE (ORDER_CHECK) & " - (H)" ); + END IF; + END; -- (H). + + BUMP := 0; + + DECLARE -- (I). + TYPE REC2 (D1, D2 : INTEGER) IS + RECORD + COMP : INTEGER; + END RECORD; + + R1 : REC2 (G * 1000, H * 10000) := + (G1 * 1000, H1 * 10000, F * 100); + R2 : REC2 (F, F * 10); + BEGIN + ORDER_CHECK := R1.D1 + R1.D2 + R1.COMP + R2.D1 + R2.D2; + IF ORDER_CHECK = 21354 OR ORDER_CHECK = 21345 OR + ORDER_CHECK = 12345 OR ORDER_CHECK = 12354 THEN + COMMENT ( "ORDER_CHECK HAS VALUE " & + INTEGER'IMAGE (ORDER_CHECK) & " - (I)" ); + ELSE + FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & + "VALUE OF ORDER_CHECK SHOULD BE 21354, " & + "21345, 12354, OR 12345 -- ACTUAL VALUE IS " & + INTEGER'IMAGE (ORDER_CHECK) & " - (I)" ); + END IF; + + END; -- (I). + + BUMP := 0; + + DECLARE -- (J). + PACKAGE P IS + TYPE PRIV (D : INTEGER) IS PRIVATE; + + P1 : CONSTANT PRIV; + P2 : CONSTANT PRIV; + + FUNCTION GET_A (P : PRIV) RETURN INTEGER; + PRIVATE + TYPE PRIV (D : INTEGER) IS + RECORD + COMP : INTEGER; + END RECORD; + P1 : CONSTANT PRIV := (F , F * 10); + P2 : CONSTANT PRIV := (F * 100, F * 1000); + END P; + + PACKAGE BODY P IS + FUNCTION GET_A (P : PRIV) RETURN INTEGER IS + BEGIN + RETURN P.COMP; + END GET_A; + END P; + + USE P; + BEGIN + ORDER_CHECK := P1.D + GET_A (P1) + P2.D + GET_A (P2); + IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR + ORDER_CHECK = 3412 OR ORDER_CHECK = 3421 THEN + COMMENT ( "ORDER_CHECK HAS VALUE " & + INTEGER'IMAGE (ORDER_CHECK) & " - (J)" ); + ELSE + FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & + "VALUE OF ORDER_CHECK SHOULD BE 4321, " & + "4312, 3421, OR 3412 -- ACTUAL VALUE IS " & + INTEGER'IMAGE (ORDER_CHECK) & " - (J)" ); + END IF; + END; -- (J). + + BUMP := 0; + + DECLARE -- (K). + PACKAGE P IS + TYPE PRIV (D1, D2 : INTEGER) IS PRIVATE; + + PRIVATE + TYPE PRIV (D1, D2 : INTEGER) IS + RECORD + NULL; + END RECORD; + END P; + + USE P; + + P1 : PRIV (F, F * 10); + P2 : PRIV (F * 100, F * 1000); + + BEGIN + ORDER_CHECK := P1.D1 + P1.D2 + P2.D1 + P2.D2; + IF ORDER_CHECK = 4321 OR ORDER_CHECK = 4312 OR + ORDER_CHECK = 3412 OR ORDER_CHECK = 3421 THEN + COMMENT ( "ORDER_CHECK HAS VALUE " & + INTEGER'IMAGE (ORDER_CHECK) & " - (K)" ); + ELSE + FAILED ( "OBJECTS NOT ELABORATED IN PROPER ORDER " & + "VALUE OF ORDER_CHECK SHOULD BE 4321, 4312, " & + "3421, OR 3412 -- ACTUAL VALUE IS " & + INTEGER'IMAGE (ORDER_CHECK) & " - (K)" ); + END IF; + + END; -- (K). + + RESULT; + END C32107A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32107c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32107c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32107c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32107c.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,164 ---- + -- C32107C.ADA + + -- 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. + --* + -- FOR OBJECTS OF A GENERIC FORMAL TYPE WHOSE ACTUAL PARAMETER IS A + -- TYPE WITH DEFAULT VALUES, CHECK THAT OBJECT DECLARATIONS ARE + -- ELABORATED IN THE ORDER OF THEIR OCCURRENCE, I.E., THAT EXPRESSIONS + -- ASSOCIATED WITH ONE DECLARATION (INCLUDING DEFAULT EXPRESSIONS) ARE + -- EVALUATED BEFORE ANY EXPRESSION BELONGING TO THE NEXT DECLARATION. + + -- R.WILLIAMS 9/24/86 + + WITH REPORT; USE REPORT; + PROCEDURE C32107C IS + + BUMP : INTEGER := 0; + + G1, H1 : INTEGER; + + FUNCTION F RETURN INTEGER IS + BEGIN + BUMP := BUMP + 1; + RETURN BUMP; + END F; + + FUNCTION G RETURN INTEGER IS + BEGIN + BUMP := BUMP + 1; + G1 := BUMP; + RETURN BUMP; + END G; + + FUNCTION H RETURN INTEGER IS + BEGIN + BUMP := BUMP + 1; + H1 := BUMP; + RETURN BUMP; + END H; + + BEGIN + TEST ( "C32107C", "FOR OBJECTS OF A GENERIC FORMAL TYPE WHOSE " & + "ACTUAL PARAMETER IS A TYPE WITH DEFAULT " & + "VALUES, CHECK THAT OBJECT DECLARATIONS ARE " & + "ELABORATED IN THE ORDER OF THEIR " & + "OCCURRENCE, I.E., THAT EXPRESSIONS " & + "ASSOCIATED WITH ONE DECLARATION (INCLUDING " & + "DEFAULT EXPRESSIONS) ARE EVALUATED BEFORE " & + "ANY EXPRESSION BELONGING TO THE NEXT " & + "DECLARATION" ); + + DECLARE -- (A). + TYPE REC (D : INTEGER := F) IS + RECORD + A : INTEGER := F; + END RECORD; + + FUNCTION GET_A (R : REC) RETURN INTEGER IS + BEGIN + RETURN R.A; + END GET_A; + + GENERIC + TYPE T IS (<>); + TYPE PRIV (D : T) IS PRIVATE; + WITH FUNCTION GET_A (P : PRIV) RETURN INTEGER IS <>; + PROCEDURE P; + + PROCEDURE P IS + P1 : PRIV (T'VAL (F)); + P2 : PRIV (T'VAL (F * 100)); + ORDER_CHECK : INTEGER; + + BEGIN + ORDER_CHECK := + T'POS (P1.D) + T'POS (P2.D) + + (GET_A (P1) * 10) + (GET_A (P2) * 1000); + IF ORDER_CHECK /= 4321 THEN + FAILED ( "OBJECTS NOT ELABORATED IN PROPER " & + "ORDER VALUE OF ORDER_CHECK SHOULD BE " & + "4321 -- ACTUAL VALUE IS " & + INTEGER'IMAGE (ORDER_CHECK) & " - (A)" ); + END IF; + END P; + + PROCEDURE PROC IS NEW P (INTEGER, REC); + + BEGIN + PROC; + END; -- (A). + + BUMP := 0; + + DECLARE -- (B). + TYPE REC (D1 : INTEGER := F; D2 : INTEGER := F) IS + RECORD + A : INTEGER := F; + END RECORD; + + FUNCTION GET_A (R : REC) RETURN INTEGER IS + BEGIN + RETURN R.A; + END GET_A; + + GENERIC + TYPE T IS (<>); + TYPE PRIV (D1 : T; D2 : T) IS PRIVATE; + WITH FUNCTION GET_A (P : PRIV) RETURN INTEGER IS <>; + PROCEDURE P; + + PROCEDURE P IS + P1 : PRIV (T'VAL (F * 1000), T'VAL (F * 10000)); + P2 : PRIV (T'VAL (F), T'VAL (F * 10)); + ORDER_CHECK : INTEGER; + + BEGIN + ORDER_CHECK := + T'POS (P1.D1) + T'POS (P1.D2) + + T'POS (P2.D1) + T'POS (P2.D2) + + (GET_A (P1) * 100); + IF (GET_A (P2) = 6) AND + (ORDER_CHECK = 12345 OR ORDER_CHECK = 21345 OR + ORDER_CHECK = 21354 OR ORDER_CHECK = 12354) THEN + COMMENT ( "ORDER_CHECK HAS VALUE " & + INTEGER'IMAGE (ORDER_CHECK) & + " - (B)" ); + ELSE + FAILED ( "OBJECTS NOT ELABORATED IN PROPER " & + "ORDER VALUE OF ORDER_CHECK SHOULD BE " & + "6 12345, 6 21345, 6 21354, OR " & + "6 12354 -- ACTUAL VALUE IS " & + INTEGER'IMAGE (GET_A (P2)) & + INTEGER'IMAGE (ORDER_CHECK) & " - (B)" ); + END IF; + + END P; + + PROCEDURE PROC IS NEW P (INTEGER, REC); + + BEGIN + PROC; + END; -- (B). + + RESULT; + END C32107C; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32108a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32108a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32108a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32108a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,78 ---- + -- C32108A.ADA + + -- 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. + --* + -- CHECK THAT DEFAULT EXPRESSIONS ARE NOT EVALUATED, IF INITIALIZATION + -- EXPRESSIONS ARE GIVEN FOR THE OBJECT DECLARATIONS. + + -- TBN 3/20/86 + + WITH REPORT; USE REPORT; + PROCEDURE C32108A IS + + FUNCTION DEFAULT_CHECK (NUMBER : INTEGER) RETURN INTEGER IS + BEGIN + IF NUMBER /= 0 THEN + FAILED ("DEFAULT EXPRESSIONS ARE EVALUATED -" & + INTEGER'IMAGE (NUMBER)); + END IF; + RETURN (1); + END DEFAULT_CHECK; + + BEGIN + TEST ("C32108A", "CHECK THAT DEFAULT EXPRESSIONS ARE NOT " & + "EVALUATED, IF INITIALIZATION EXPRESSIONS ARE " & + "GIVEN FOR THE OBJECT DECLARATIONS"); + + DECLARE -- (A) + + TYPE REC_TYP1 IS + RECORD + AGE : INTEGER := DEFAULT_CHECK (1); + END RECORD; + + REC1 : REC_TYP1 := (AGE => DEFAULT_CHECK (0)); + + + TYPE REC_TYP2 (D : INTEGER := DEFAULT_CHECK (2)) IS + RECORD + NULL; + END RECORD; + + REC2 : REC_TYP2 (DEFAULT_CHECK (0)); + + + TYPE REC_TYP3 (D : INTEGER := DEFAULT_CHECK (3)) IS + RECORD + A : INTEGER := DEFAULT_CHECK (4); + END RECORD; + + REC3 : REC_TYP3 := (D => DEFAULT_CHECK (0), + A => DEFAULT_CHECK (0)); + + BEGIN -- (A) + NULL; + END; -- (A) + + RESULT; + END C32108A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32108b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32108b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32108b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32108b.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,80 ---- + -- C32108B.ADA + + -- 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. + --* + -- CHECK THAT IF A DEFAULT EXPRESSION IS EVALUATED FOR A COMPONENT, NO + -- DEFAULT EXPRESSIONS ARE EVALUATED FOR ANY SUBCOMPONENTS. + + -- TBN 3/21/86 + + WITH REPORT; USE REPORT; + PROCEDURE C32108B IS + + FUNCTION DEFAULT_CHECK (NUMBER : INTEGER) RETURN INTEGER IS + BEGIN + IF NUMBER /= 0 THEN + FAILED ("SUBCOMPONENT DEFAULT EXPRESSIONS ARE " & + "EVALUATED -" & INTEGER'IMAGE (NUMBER)); + END IF; + RETURN (1); + END DEFAULT_CHECK; + + BEGIN + TEST ("C32108B", "CHECK THAT IF A DEFAULT EXPRESSION IS " & + "EVALUATED FOR A COMPONENT, NO DEFAULT " & + "EXPRESSIONS ARE EVALUATED FOR ANY " & + "SUBCOMPONENTS"); + + DECLARE -- (A) + + TYPE REC_TYP1 IS + RECORD + AGE : INTEGER := DEFAULT_CHECK (1); + END RECORD; + + TYPE REC_TYP2 (D : INTEGER := DEFAULT_CHECK(2)) IS + RECORD + NULL; + END RECORD; + + TYPE REC_TYP3 (D : INTEGER := DEFAULT_CHECK(3)) IS + RECORD + A : INTEGER := DEFAULT_CHECK(4); + END RECORD; + + TYPE REC_TYP4 IS + RECORD + ONE : REC_TYP1 := (AGE => DEFAULT_CHECK (0)); + TWO : REC_TYP2 (DEFAULT_CHECK(0)); + THREE : REC_TYP3 := (D => DEFAULT_CHECK (0), + A => DEFAULT_CHECK (0)); + END RECORD; + + REC4 : REC_TYP4; + + BEGIN -- (A) + NULL; + END; -- (A) + + RESULT; + END C32108B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32111a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32111a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32111a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32111a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,282 ---- + -- C32111A.ADA + + -- 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 WHEN A VARIABLE OR CONSTANT HAVING AN ENUMERATION, + -- INTEGER, FLOAT OR FIXED TYPE IS DECLARED WITH AN INITIAL VALUE, + -- CONSTRAINT_ERROR IS RAISED IF THE INITIAL VALUE LIES OUTSIDE THE + -- RANGE OF THE SUBTYPE. + + -- HISTORY: + -- RJW 07/20/86 CREATED ORIGINAL TEST. + -- JET 08/04/87 IMPROVED DEFEAT OF COMPILER OPTIMIZATION. + + WITH REPORT; USE REPORT; + + PROCEDURE C32111A IS + + TYPE WEEKDAY IS (MON, TUES, WED, THURS, FRI); + SUBTYPE MIDWEEK IS WEEKDAY RANGE WED .. WED; + + SUBTYPE DIGIT IS CHARACTER RANGE '0' .. '9'; + + SUBTYPE SHORT IS INTEGER RANGE -100 .. 100; + + TYPE INT IS RANGE -10 .. 10; + SUBTYPE PINT IS INT RANGE 1 .. 10; + + TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0; + SUBTYPE SFLT IS FLT RANGE -5.0 .. 0.0; + + TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0; + SUBTYPE SFIXED IS FIXED RANGE 0.0 .. 5.0; + + BEGIN + TEST ("C32111A", "CHECK THAT WHEN A VARIABLE OR CONSTANT " & + "HAVING AN ENUMERATION, INTEGER, FLOAT OR " & + "FIXED TYPE IS DECLARED WITH AN INITIAL " & + "VALUE, CONSTRAINT_ERROR IS RAISED IF THE " & + "INITIAL VALUE LIES OUTSIDE THE RANGE OF THE " & + "SUBTYPE" ); + + BEGIN + DECLARE + D : MIDWEEK := WEEKDAY'VAL (IDENT_INT (1)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'D'" ); + IF D = TUES THEN + COMMENT ("VARIABLE 'D' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'D'" ); + END; + + BEGIN + DECLARE + D : CONSTANT WEEKDAY RANGE WED .. WED := + WEEKDAY'VAL (IDENT_INT (3)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'D'" ); + IF D = TUES THEN + COMMENT ("INITIALIZE VARIABLE 'D'"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'D'" ); + END; + + BEGIN + DECLARE + P : CONSTANT DIGIT := IDENT_CHAR ('/'); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'P'" ); + IF P = '0' THEN + COMMENT ("VARIABLE 'P' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'P'" ); + END; + + BEGIN + DECLARE + Q : CHARACTER RANGE 'A' .. 'E' := IDENT_CHAR ('F'); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'Q'" ); + IF Q = 'A' THEN + COMMENT ("VARIABLE 'Q' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'Q'" ); + END; + + BEGIN + DECLARE + I : SHORT := IDENT_INT (-101); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'I'" ); + IF I = 1 THEN + COMMENT ("VARIABLE 'I' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'I'" ); + END; + + BEGIN + DECLARE + J : CONSTANT INTEGER RANGE 0 .. 100 := IDENT_INT (101); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'J'" ); + IF J = -1 THEN + COMMENT ("VARIABLE 'J' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'J'" ); + END; + + BEGIN + DECLARE + K : INT RANGE 0 .. 1 := INT (IDENT_INT (2)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'K'" ); + IF K = 2 THEN + COMMENT ("VARIABLE 'K' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'K'" ); + END; + + BEGIN + DECLARE + L : CONSTANT PINT := INT (IDENT_INT (0)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'L'" ); + IF L = 1 THEN + COMMENT ("VARIABLE 'L' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'L'" ); + END; + + BEGIN + DECLARE + FL : SFLT := FLT (IDENT_INT (1)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'FL'" ); + IF FL = 3.14 THEN + COMMENT ("VARIABLE 'FL' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'FL'" ); + END; + + BEGIN + DECLARE + FL1 : CONSTANT FLT RANGE 0.0 .. 0.0 := + FLT (IDENT_INT (-1)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'FL1'" ); + IF FL1 = 0.0 THEN + COMMENT ("VARIABLE 'FL1' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'FL1'" ); + END; + + BEGIN + DECLARE + FI : FIXED RANGE 0.0 .. 0.0 := IDENT_INT (1) * 0.5; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'FI'" ); + IF FI = 0.5 THEN + COMMENT ("VARIABLE 'FI' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'FI'" ); + END; + + BEGIN + DECLARE + FI1 : CONSTANT SFIXED := IDENT_INT (-1) * 0.5; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'FI1'" ); + IF FI1 = 0.5 THEN + COMMENT ("VARIABLE 'FI1' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'FI1'" ); + END; + + RESULT; + END C32111A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32111b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32111b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32111b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32111b.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,282 ---- + -- C32111B.ADA + + -- 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 WHEN A VARIABLE OR CONSTANT HAVING AN ENUMERATION, + -- INTEGER, FLOAT OR FIXED TYPE IS DECLARED WITH AN INITIAL STATIC + -- VALUE, CONSTRAINT_ERROR IS RAISED IF THE INITIAL VALUE LIES + -- OUTSIDE THE RANGE OF THE SUBTYPE. + + -- HISTORY: + -- JET 08/04/87 CREATED ORIGINAL TEST BASED ON C32111A BY RJW + -- BUT WITH STATIC VALUES INSTEAD OF DYNAMIC + -- IDENTITY FUNCTION. + + WITH REPORT; USE REPORT; + + PROCEDURE C32111B IS + + TYPE WEEKDAY IS (MON, TUES, WED, THURS, FRI); + SUBTYPE MIDWEEK IS WEEKDAY RANGE WED .. WED; + + SUBTYPE DIGIT IS CHARACTER RANGE '0' .. '9'; + + SUBTYPE SHORT IS INTEGER RANGE -100 .. 100; + + TYPE INT IS RANGE -10 .. 10; + SUBTYPE PINT IS INT RANGE 1 .. 10; + + TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0; + SUBTYPE SFLT IS FLT RANGE -5.0 .. 0.0; + + TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0; + SUBTYPE SFIXED IS FIXED RANGE 0.0 .. 5.0; + + BEGIN + TEST ("C32111B", "CHECK THAT WHEN A VARIABLE OR CONSTANT " & + "HAVING AN ENUMERATION, INTEGER, FLOAT OR " & + "FIXED TYPE IS DECLARED WITH AN INITIAL STATIC " & + "VALUE, CONSTRAINT_ERROR IS RAISED IF THE " & + "INITIAL VALUE LIES OUTSIDE THE RANGE OF THE " & + "SUBTYPE" ); + + BEGIN + DECLARE + D : MIDWEEK := WEEKDAY'VAL (1); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'D'" ); + IF D = TUES THEN + COMMENT ("VARIABLE 'D' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'D'" ); + END; + + BEGIN + DECLARE + D : CONSTANT WEEKDAY RANGE WED .. WED := + WEEKDAY'VAL (3); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'D'" ); + IF D = TUES THEN + COMMENT ("INITIALIZE VARIABLE 'D'"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'D'" ); + END; + + BEGIN + DECLARE + P : CONSTANT DIGIT := '/'; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'P'" ); + IF P = '0' THEN + COMMENT ("VARIABLE 'P' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'P'" ); + END; + + BEGIN + DECLARE + Q : CHARACTER RANGE 'A' .. 'E' := 'F'; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'Q'" ); + IF Q = 'A' THEN + COMMENT ("VARIABLE 'Q' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'Q'" ); + END; + + BEGIN + DECLARE + I : SHORT := -101; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'I'" ); + IF I = 1 THEN + COMMENT ("VARIABLE 'I' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'I'" ); + END; + + BEGIN + DECLARE + J : CONSTANT INTEGER RANGE 0 .. 100 := 101; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'J'" ); + IF J = -1 THEN + COMMENT ("VARIABLE 'J' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'J'" ); + END; + + BEGIN + DECLARE + K : INT RANGE 0 .. 1 := 2; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'K'" ); + IF K = 2 THEN + COMMENT ("VARIABLE 'K' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'K'" ); + END; + + BEGIN + DECLARE + L : CONSTANT PINT := 0; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'L'" ); + IF L = 1 THEN + COMMENT ("VARIABLE 'L' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'L'" ); + END; + + BEGIN + DECLARE + FL : SFLT := 1.0; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'FL'" ); + IF FL = 3.14 THEN + COMMENT ("VARIABLE 'FL' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'FL'" ); + END; + + BEGIN + DECLARE + FL1 : CONSTANT FLT RANGE 0.0 .. 0.0 := -1.0; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'FL1'" ); + IF FL1 = 0.0 THEN + COMMENT ("VARIABLE 'FL1' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'FL1'" ); + END; + + BEGIN + DECLARE + FI : FIXED RANGE 0.0 .. 0.0 := 0.5; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'FI'" ); + IF FI = 0.5 THEN + COMMENT ("VARIABLE 'FI' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'FI'" ); + END; + + BEGIN + DECLARE + FI1 : CONSTANT SFIXED := -0.5; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'FI1'" ); + IF FI1 = 0.5 THEN + COMMENT ("VARIABLE 'FI1' INITIALIZED"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'FI1'" ); + END; + + RESULT; + END C32111B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32112b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32112b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32112b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32112b.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,267 ---- + -- C32112B.ADA + + -- 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. + --* + -- CHECK THAT CONSTRAINT_ERROR IS RAISED FOR THE DECLARATION OF A NULL + -- ARRAY OBJECT IF THE INITIAL VALUE IS NOT A NULL ARRAY. + + -- RJW 7/20/86 + -- GMT 7/01/87 ADDED CODE TO PREVENT DEAD VARIABLE OPTIMIZATION. + -- CHANGED THE RANGE VALUES OF A FEW DIMENSIONS. + + WITH REPORT; USE REPORT; + + PROCEDURE C32112B IS + + TYPE ARR1 IS ARRAY (NATURAL RANGE <>) OF INTEGER; + SUBTYPE NARR1 IS ARR1 (IDENT_INT (2) .. IDENT_INT (1)); + + + TYPE ARR2 IS ARRAY (NATURAL RANGE <>, NATURAL RANGE <>) + OF INTEGER; + SUBTYPE NARR2 IS ARR2 (IDENT_INT (1) .. IDENT_INT (2), + IDENT_INT (1) .. IDENT_INT (0)); + + BEGIN + TEST ("C32112B", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR " & + "THE DECLARATION OF A NULL ARRAY OBJECT IF " & + "THE INITIAL VALUE IS NOT A NULL ARRAY"); + + BEGIN + DECLARE + A : ARR1 (IDENT_INT(1) .. IDENT_INT(2)); + N1A : NARR1 := (A'RANGE => 0); + BEGIN + FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'N1A'"); + A(1) := IDENT_INT(N1A(1)); + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'N1A'"); + END; + + BEGIN + DECLARE + A : ARR1 (IDENT_INT (1) .. IDENT_INT (2)); + N1B : CONSTANT NARR1 := (A'RANGE => 0); + BEGIN + FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'N1B'"); + A(1) := IDENT_INT(N1B(1)); + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'N1B'"); + END; + + BEGIN + DECLARE + A : ARR1 (IDENT_INT (1) .. IDENT_INT (1)); + N1C : CONSTANT NARR1 := (A'RANGE => 0); + BEGIN + FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'N1C'"); + A(1) := IDENT_INT(N1C(1)); + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'N1C'"); + END; + + BEGIN + DECLARE + A : ARR1 (IDENT_INT (1) .. IDENT_INT (1)); + N1D : NARR1 := (A'RANGE => 0); + BEGIN + FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'N1D'"); + A(1) := IDENT_INT(N1D(1)); + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'N1D'"); + END; + + BEGIN + DECLARE + A : ARR1 (IDENT_INT (0) .. IDENT_INT (1)); + N1E : ARR1 (IDENT_INT (1) .. IDENT_INT (0)) := + (A'RANGE => 0); + BEGIN + FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'N1E'"); + A(1) := IDENT_INT(N1E(1)); + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'N1E'"); + END; + + BEGIN + DECLARE + A : ARR1 (IDENT_INT (0) .. IDENT_INT (1)); + N1F : CONSTANT ARR1 (IDENT_INT (1) .. IDENT_INT (0)) := + (A'RANGE => 0); + BEGIN + FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'N1F'"); + A(1) := IDENT_INT(N1F(1)); + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'N1F'"); + END; + + BEGIN + DECLARE + A : ARR2 (IDENT_INT (1) .. IDENT_INT (2), + IDENT_INT (0) .. IDENT_INT (1)); + N2A : CONSTANT NARR2 := (A'RANGE => (A'RANGE (2) =>0)); + BEGIN + FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'N2'"); + A(1,1) := IDENT_INT(N2A(1,1)); + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'N2A'"); + END; + + BEGIN + DECLARE + A : ARR2 (IDENT_INT (1) .. IDENT_INT (2), + IDENT_INT (0) .. IDENT_INT (1)); + N2B : NARR2 := (A'RANGE => (A'RANGE (2) =>0)); + BEGIN + FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'N2B'"); + A(1,1) := IDENT_INT(N2B(1,1)); + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'N2B'"); + END; + + BEGIN + DECLARE + A : ARR2 (IDENT_INT (1) .. IDENT_INT (3), + IDENT_INT (1) .. IDENT_INT (1)); + N2C : CONSTANT NARR2 := (A'RANGE => (A'RANGE (2) =>0)); + BEGIN + FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'N2C'"); + A(1,1) := IDENT_INT(N2C(1,1)); + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'N2C'"); + END; + + BEGIN + DECLARE + A : ARR2 (IDENT_INT (1) .. IDENT_INT (3), + IDENT_INT (1) .. IDENT_INT (1)); + N2D : NARR2 := (A'RANGE => (A'RANGE (2) =>0)); + BEGIN + FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'N2D'"); + A(1,1) := IDENT_INT(N2D(1,1)); + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'N2D'"); + END; + + BEGIN + DECLARE + A : ARR2 (IDENT_INT (1) .. IDENT_INT (1), + IDENT_INT (1) .. IDENT_INT (1)); + N2E : CONSTANT ARR2 (IDENT_INT (2) .. IDENT_INT (1), + IDENT_INT (1) .. IDENT_INT (1)) := + (A'RANGE => (A'RANGE (2) =>0)); + BEGIN + FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'N2E'"); + A(1,1) := IDENT_INT(N2E(1,1)); + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'N2E'"); + END; + + BEGIN + DECLARE + A : ARR2 (IDENT_INT (1) .. IDENT_INT (1), + IDENT_INT (1) .. IDENT_INT (1)); + N2F : ARR2 (IDENT_INT (2) .. IDENT_INT (1), + IDENT_INT (1) .. IDENT_INT (1)) := + (A'RANGE => (A'RANGE (2) =>0)); + BEGIN + FAILED ("NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'N2F'"); + A(1,1) := IDENT_INT(N2F(1,1)); + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ("WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'N2F'"); + END; + + RESULT; + END C32112B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32113a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32113a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32113a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32113a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,534 ---- + -- C32113A.ADA + + -- 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 WHEN A VARIABLE OR CONSTANT HAVING A CONSTRAINED TYPE + -- WITH DISCRIMINANTS IS DECLARED WITH AN INITIAL VALUE, + -- CONSTRAINT_ERROR IS RAISED IF THE CORRESPONDING DISCRIMINANTS OF + -- THE INITIAL VALUE AND THE SUBTYPE DO NOT HAVE THE SAME VALUE. + + -- HISTORY: + -- RJW 07/20/86 + -- DWC 06/22/87 ADDED SUBTYPE PRIVAS. ADDED CODE TO PREVENT DEAD + -- VARIABLE OPTIMIZATION. + + WITH REPORT; USE REPORT; + + PROCEDURE C32113A IS + + PACKAGE PKG IS + TYPE PRIVA (D : INTEGER := 0) IS PRIVATE; + SUBTYPE PRIVAS IS PRIVA (IDENT_INT (1)); + PRA1 : CONSTANT PRIVAS; + + TYPE PRIVB (D1, D2 : INTEGER) IS PRIVATE; + PRB12 : CONSTANT PRIVB; + + PRIVATE + TYPE PRIVA (D : INTEGER := 0) IS + RECORD + NULL; + END RECORD; + + TYPE PRIVB (D1, D2 : INTEGER) IS + RECORD + NULL; + END RECORD; + + PRA1 : CONSTANT PRIVAS := (D => (IDENT_INT (1))); + PRB12 : CONSTANT PRIVB := (IDENT_INT (1), IDENT_INT (2)); + END PKG; + + USE PKG; + + TYPE RECA (D : INTEGER := 0) IS + RECORD + NULL; + END RECORD; + + TYPE RECB (D1, D2 : INTEGER) IS + RECORD + NULL; + END RECORD; + + RA1 : CONSTANT RECA (IDENT_INT (1)) := (D => (IDENT_INT (1))); + + RB12 : CONSTANT RECB := (IDENT_INT (1), IDENT_INT (2)); + + BEGIN + TEST ("C32113A", "CHECK THAT WHEN A VARIABLE OR CONSTANT " & + "HAVING A CONSTRAINED TYPE IS DECLARED WITH " & + "AN INITIAL VALUE, CONSTRAINT_ERROR IS " & + "RAISED IF THE CORRESPONDING DISCRIMINANTS " & + "OF THE INITIAL VALUE AND THE SUBTYPE DO " & + "NOT HAVE THE SAME VALUE" ); + + BEGIN + DECLARE + PR1 : CONSTANT PRIVA (IDENT_INT (0)) := PRA1; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'PR1'" ); + IF PR1 = PRA1 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'PR1'" ); + END; + + BEGIN + DECLARE + PR2 : CONSTANT PRIVA (IDENT_INT (2)) := PRA1; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'PR2'" ); + IF PR2 = PRA1 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'PR2'" ); + END; + + BEGIN + DECLARE + PR3 : PRIVA (IDENT_INT (0)) := PRA1; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'PR3'" ); + IF PR3 = PRA1 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'PR3'" ); + END; + + BEGIN + DECLARE + PR4 : PRIVA (IDENT_INT (2)) := PRA1; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'PR4'" ); + IF PR4 = PRA1 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'PR4'" ); + END; + + BEGIN + DECLARE + SUBTYPE SPRIVA IS PRIVA (IDENT_INT (-1)); + PR5 : CONSTANT SPRIVA := PRA1; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'PR5'" ); + IF PR5 = PRA1 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'PR5'" ); + END; + + BEGIN + DECLARE + SUBTYPE SPRIVA IS PRIVA (IDENT_INT (3)); + PR6 : SPRIVA := PRA1; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'PR6'" ); + IF PR6 = PRA1 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'PR6'" ); + END; + + BEGIN + DECLARE + PR7 : CONSTANT PRIVB (IDENT_INT (1), IDENT_INT (1)) := + PRB12; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'PR7'" ); + IF PR7 = PRB12 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'PR7'" ); + END; + + BEGIN + DECLARE + PR8 : CONSTANT PRIVB (IDENT_INT (2), IDENT_INT (2)) := + PRB12; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'PR8'" ); + IF PR8 = PRB12 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'PR8'" ); + END; + + BEGIN + DECLARE + PR9 : PRIVB (IDENT_INT (1), IDENT_INT (1)) := PRB12; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'PR9'" ); + IF PR9 = PRB12 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'PR9'" ); + END; + + BEGIN + DECLARE + PR10 : PRIVB (IDENT_INT (2), IDENT_INT (2)) := PRB12; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'PR10'" ); + IF PR10 = PRB12 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'PR10'" ); + END; + + BEGIN + DECLARE + SUBTYPE SPRIVB IS + PRIVB (IDENT_INT (-1), IDENT_INT (-2)); + PR11 : CONSTANT SPRIVB := PRB12; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'PR11'" ); + IF PR11 = PRB12 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'PR11'" ); + END; + + BEGIN + DECLARE + SUBTYPE SPRIVB IS PRIVB (IDENT_INT (2), IDENT_INT (1)); + PR12 : SPRIVB := PRB12; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'PR12'" ); + IF PR12 = PRB12 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'PR12'" ); + END; + + BEGIN + DECLARE + R1 : CONSTANT RECA (IDENT_INT (0)) := RA1; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'R1'" ); + IF R1 = RA1 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'R1'" ); + END; + + BEGIN + DECLARE + R2 : CONSTANT RECA (IDENT_INT (2)) := RA1; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'R2'" ); + IF R2 = RA1 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'R2'" ); + END; + + BEGIN + DECLARE + R3 : RECA (IDENT_INT (0)) := RA1; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'R3'" ); + IF R3 = RA1 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'R3'" ); + END; + + BEGIN + DECLARE + R4 : RECA (IDENT_INT (2)) := RA1; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'R4'" ); + IF R4 = RA1 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'R4'" ); + END; + + BEGIN + DECLARE + SUBTYPE SRECA IS RECA (IDENT_INT (-1)); + R5 : CONSTANT SRECA := RA1; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'R5'" ); + IF R5 = RA1 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'R5'" ); + END; + + BEGIN + DECLARE + SUBTYPE SRECA IS RECA (IDENT_INT (3)); + R6 : SRECA := RA1; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'R6'" ); + IF R6 = RA1 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'R6'" ); + END; + + BEGIN + DECLARE + R7 : CONSTANT RECB (IDENT_INT (1), IDENT_INT (1)) := + RB12; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'R7'" ); + IF R7 = RB12 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'R7'" ); + END; + + BEGIN + DECLARE + R8 : CONSTANT RECB (IDENT_INT (2), IDENT_INT (2)) := + RB12; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'R8'" ); + IF R8 = RB12 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'R8'" ); + END; + + BEGIN + DECLARE + R9 : RECB (IDENT_INT (1), IDENT_INT (1)) := RB12; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'R9'" ); + IF R9 = RB12 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'R9'" ); + END; + + BEGIN + DECLARE + R10 : RECB (IDENT_INT (2), IDENT_INT (2)) := RB12; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'R10'" ); + IF R10 = RB12 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'R10'" ); + END; + + BEGIN + DECLARE + SUBTYPE SRECB IS + RECB (IDENT_INT (-1), IDENT_INT (-2)); + R11 : CONSTANT SRECB := RB12; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'R11'" ); + IF R11 = RB12 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'R11'" ); + END; + + BEGIN + DECLARE + SUBTYPE SRECB IS RECB (IDENT_INT (2), IDENT_INT (1)); + R12 : SRECB := RB12; + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'R12'" ); + IF R12 = RB12 THEN + COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'R12'" ); + END; + + RESULT; + END C32113A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32115a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32115a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32115a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32115a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,338 ---- + -- C32115A.ADA + + -- 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 WHEN A VARIABLE OR CONSTANT HAVING A CONSTRAINED + -- ACCESS TYPE IS DECLARED WITH AN INITIAL NON-NULL ACCESS VALUE, + -- CONSTRAINT_ERROR IS RAISED IF AN INDEX BOUND OR A DISCRIMINANT + -- VALUE OF THE DESIGNATED OBJECT DOES NOT EQUAL THE CORRESPONDING + -- VALUE SPECIFIED FOR THE ACCESS SUBTYPE. + + -- HISTORY: + -- RJW 07/20/86 CREATED ORIGINAL TEST. + -- JET 08/05/87 ADDED DEFEAT OF DEAD VARIABLE OPTIMIZATION. + -- PWN 11/30/94 REMOVED TEST ILLEGAL IN ADA 9X. + + WITH REPORT; USE REPORT; + + PROCEDURE C32115A IS + + PACKAGE PKG IS + TYPE PRIV (D : INTEGER) IS PRIVATE; + + PRIVATE + TYPE PRIV (D : INTEGER) IS + RECORD + NULL; + END RECORD; + END PKG; + + USE PKG; + + TYPE ACCP IS ACCESS PRIV (IDENT_INT (1)); + + TYPE REC (D : INTEGER) IS + RECORD + NULL; + END RECORD; + + TYPE ACCR IS ACCESS REC (IDENT_INT (2)); + + TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER; + + TYPE ACCA IS ACCESS ARR (IDENT_INT (1) .. IDENT_INT (2)); + + TYPE ACCN IS ACCESS ARR (IDENT_INT (1) .. IDENT_INT (0)); + + BEGIN + TEST ("C32115A", "CHECK THAT WHEN A VARIABLE OR CONSTANT " & + "HAVING A CONSTRAINED ACCESS TYPE IS " & + "DECLARED WITH AN INITIAL NON-NULL ACCESS " & + "VALUE, CONSTRAINT_ERROR IS RAISED IF AN " & + "INDEX BOUND OR A DISCRIMINANT VALUE OF THE " & + "DESIGNATED OBJECT DOES NOT EQUAL THE " & + "CORRESPONDING VALUE SPECIFIED FOR THE " & + "ACCESS SUBTYPE" ); + + BEGIN + DECLARE + AC1 : CONSTANT ACCP := NEW PRIV (D => (IDENT_INT (2))); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC1'" ); + IF AC1 /= NULL THEN + COMMENT ("DEFEAT 'AC1' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC1'" ); + END; + + BEGIN + DECLARE + AC2 : ACCP := NEW PRIV (D => (IDENT_INT (2))); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC2'" ); + IF AC2 /= NULL THEN + COMMENT ("DEFEAT 'AC2' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC2'" ); + END; + + BEGIN + DECLARE + AC3 : CONSTANT ACCP := NEW PRIV (D => (IDENT_INT (0))); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC3'" ); + IF AC3 /= NULL THEN + COMMENT ("DEFEAT 'AC3' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC3'" ); + END; + + BEGIN + DECLARE + AC4 : ACCP := NEW PRIV (D => (IDENT_INT (0))); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC4'" ); + IF AC4 /= NULL THEN + COMMENT ("DEFEAT 'AC4' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC4'" ); + END; + + BEGIN + DECLARE + AC5 : CONSTANT ACCR := NEW REC'(D => (IDENT_INT (1))); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC5'" ); + IF AC5 /= NULL THEN + COMMENT ("DEFEAT 'AC5' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC5'" ); + END; + + BEGIN + DECLARE + AC6 : ACCR := NEW REC' (D => (IDENT_INT (1))); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC6'" ); + IF AC6 /= NULL THEN + COMMENT ("DEFEAT 'AC6' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC6'" ); + END; + + BEGIN + DECLARE + AC7 : CONSTANT ACCR := NEW REC'(D => (IDENT_INT (3))); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC7'" ); + IF AC7 /= NULL THEN + COMMENT ("DEFEAT 'AC7' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC7'" ); + END; + + BEGIN + DECLARE + AC8 : ACCR := NEW REC' (D => (IDENT_INT (3))); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC8'" ); + IF AC8 /= NULL THEN + COMMENT ("DEFEAT 'AC8' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC8'" ); + END; + + BEGIN + DECLARE + AC9 : CONSTANT ACCA := + NEW ARR'(IDENT_INT (1) .. IDENT_INT (1) => 0); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC9'" ); + IF AC9 /= NULL THEN + COMMENT ("DEFEAT 'AC9' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC9'" ); + END; + + BEGIN + DECLARE + AC10 : ACCA := + NEW ARR'(IDENT_INT (1) .. IDENT_INT (1) => 0); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC10'" ); + IF AC10 /= NULL THEN + COMMENT ("DEFEAT 'AC10' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC10'" ); + END; + + BEGIN + DECLARE + AC11 : CONSTANT ACCA := + NEW ARR' (IDENT_INT (0) .. IDENT_INT (2) => 0); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC11'" ); + IF AC11 /= NULL THEN + COMMENT ("DEFEAT 'AC11' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC11'" ); + END; + + BEGIN + DECLARE + AC12 : ACCA := + NEW ARR'(IDENT_INT (0) .. IDENT_INT (2) => 0); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC12'" ); + IF AC12 /= NULL THEN + COMMENT ("DEFEAT 'AC12' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC12'" ); + END; + + + BEGIN + DECLARE + AC15 : CONSTANT ACCN := + NEW ARR' (IDENT_INT (0) .. IDENT_INT (0) => 0); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC15'" ); + IF AC15 /= NULL THEN + COMMENT ("DEFEAT 'AC15' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC15'" ); + END; + + BEGIN + DECLARE + AC16 : ACCN := + NEW ARR'(IDENT_INT (0) .. IDENT_INT (0) => 0); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC16'" ); + IF AC16 /= NULL THEN + COMMENT ("DEFEAT 'AC16' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC16'" ); + END; + + RESULT; + END C32115A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32115b.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32115b.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c32115b.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c32115b.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,376 ---- + -- C32115B.ADA + + -- 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 WHEN A VARIABLE OR CONSTANT HAVING AN UNCONSTRAINED + -- ACCESS TYPE IS DECLARED WITH AN INITIAL NON-NULL ACCESS VALUE, + -- CONSTRAINT_ERROR IS RAISED IF AN INDEX BOUND OR A DISCRIMINANT + -- VALUE OF THE DESIGNATED OBJECT DOES NOT EQUAL THE CORRESPONDING + -- VALUE SPECIFIED FOR THE ACCESS SUBTYPE OF THE OBJECT. + + -- HISTORY: + -- JET 08/05/87 CREATED ORIGINAL TEST BASED ON C32115A BY RJW + -- BUT WITH UNCONSTRAINED ACCESS TYPES AND + -- CONSTRAINED VARIABLE/CONSTANT DECLARATIONS. + -- KAS 12/4/95 FIXED TYPO IN CALL TO REPORT.TEST + + WITH REPORT; USE REPORT; + + PROCEDURE C32115B IS + + PACKAGE PKG IS + TYPE PRIV (D : INTEGER) IS PRIVATE; + + PRIVATE + TYPE PRIV (D : INTEGER) IS + RECORD + NULL; + END RECORD; + END PKG; + + USE PKG; + + TYPE ACCP IS ACCESS PRIV; + + TYPE REC (D : INTEGER) IS + RECORD + NULL; + END RECORD; + + TYPE ACCR IS ACCESS REC; + + TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER; + + TYPE ACCA IS ACCESS ARR; + + TYPE ACCN IS ACCESS ARR; + + BEGIN + TEST ("C32115B", "CHECK THAT WHEN CONSTRAINED VARIABLE OR " & + "CONSTANT HAVING AN UNCONSTRAINED ACCESS TYPE " & + "IS DECLARED WITH AN INITIAL NON-NULL ACCESS " & + "VALUE, CONSTRAINT_ERROR IS RAISED IF AN " & + "INDEX BOUND OR A DISCRIMINANT VALUE OF THE " & + "DESIGNATED OBJECT DOES NOT EQUAL THE " & + "CORRESPONDING VALUE SPECIFIED FOR THE " & + "ACCESS SUBTYPE OF THE OBJECT" ); + + BEGIN + DECLARE + AC1 : CONSTANT ACCP(1) := NEW PRIV (IDENT_INT (2)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC1'" ); + IF AC1 /= NULL THEN + COMMENT ("DEFEAT 'AC1' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC1'" ); + END; + + BEGIN + DECLARE + AC2 : ACCP(1) := NEW PRIV (IDENT_INT (2)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC2'" ); + IF AC2 /= NULL THEN + COMMENT ("DEFEAT 'AC2' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC2'" ); + END; + + BEGIN + DECLARE + AC3 : CONSTANT ACCP(1) := NEW PRIV (IDENT_INT (0)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC3'" ); + IF AC3 /= NULL THEN + COMMENT ("DEFEAT 'AC3' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC3'" ); + END; + + BEGIN + DECLARE + AC4 : ACCP(1) := NEW PRIV (IDENT_INT (0)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC4'" ); + IF AC4 /= NULL THEN + COMMENT ("DEFEAT 'AC4' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC4'" ); + END; + + BEGIN + DECLARE + AC5 : CONSTANT ACCR(2) := NEW REC(IDENT_INT (1)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC5'" ); + IF AC5 /= NULL THEN + COMMENT ("DEFEAT 'AC5' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC5'" ); + END; + + BEGIN + DECLARE + AC6 : ACCR(2) := NEW REC (IDENT_INT (1)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC6'" ); + IF AC6 /= NULL THEN + COMMENT ("DEFEAT 'AC6' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC6'" ); + END; + + BEGIN + DECLARE + AC7 : CONSTANT ACCR(2) := NEW REC(IDENT_INT (3)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC7'" ); + IF AC7 /= NULL THEN + COMMENT ("DEFEAT 'AC7' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC7'" ); + END; + + BEGIN + DECLARE + AC8 : ACCR(2) := NEW REC (IDENT_INT (3)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC8'" ); + IF AC8 /= NULL THEN + COMMENT ("DEFEAT 'AC8' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC8'" ); + END; + + BEGIN + DECLARE + AC9 : CONSTANT ACCA(1 .. 2) := + NEW ARR(IDENT_INT(1) .. IDENT_INT (1)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC9'" ); + IF AC9 /= NULL THEN + COMMENT ("DEFEAT 'AC9' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC9'" ); + END; + + BEGIN + DECLARE + AC10 : ACCA (1..2) := + NEW ARR(IDENT_INT (1) .. IDENT_INT (1)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC10'" ); + IF AC10 /= NULL THEN + COMMENT ("DEFEAT 'AC10' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC10'" ); + END; + + BEGIN + DECLARE + AC11 : CONSTANT ACCA(1..2) := + NEW ARR(IDENT_INT (0) .. IDENT_INT (2)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC11'" ); + IF AC11 /= NULL THEN + COMMENT ("DEFEAT 'AC11' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC11'" ); + END; + + BEGIN + DECLARE + AC12 : ACCA(1..2) := + NEW ARR(IDENT_INT (0) .. IDENT_INT (2)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC12'" ); + IF AC12 /= NULL THEN + COMMENT ("DEFEAT 'AC12' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC12'" ); + END; + + BEGIN + DECLARE + AC13 : CONSTANT ACCA (1..2) := + NEW ARR(IDENT_INT (2) .. IDENT_INT (3)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC13'" ); + IF AC13 /= NULL THEN + COMMENT ("DEFEAT 'AC13' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC13'" ); + END; + + BEGIN + DECLARE + AC14 : ACCA(1..2) := + NEW ARR(IDENT_INT (2) .. IDENT_INT (3)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC14'" ); + IF AC14 /= NULL THEN + COMMENT ("DEFEAT 'AC14' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC14'" ); + END; + + BEGIN + DECLARE + AC15 : CONSTANT ACCN(1..0) := + NEW ARR(IDENT_INT (0) .. IDENT_INT (0)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC15'" ); + IF AC15 /= NULL THEN + COMMENT ("DEFEAT 'AC15' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF CONSTANT 'AC15'" ); + END; + + BEGIN + DECLARE + AC16 : ACCN(1..0) := + NEW ARR(IDENT_INT (0) .. IDENT_INT (0)); + BEGIN + FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC16'" ); + IF AC16 /= NULL THEN + COMMENT ("DEFEAT 'AC16' OPTIMIZATION"); + END IF; + END; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " & + "OF VARIABLE 'AC16'" ); + END; + + RESULT; + END C32115B; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c330001.a gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c330001.a *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c330001.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c330001.a 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,354 ---- + -- C330001.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 a variable object of an indefinite type is properly + -- initialized/constrained by an initial value assignment that is + -- a) an aggregate, b) a function, or c) an object. Check that objects + -- of the above types do not need explicit constraints if they have + -- initial values. + -- + -- TEST DESCRIPTION: + -- An indefinite subtype is either: + -- a) An unconstrained array subtype. + -- b) A subtype with unknown discriminants. + -- c) A subtype with unconstrained discriminants without defaults. + -- + -- Declare several indefinite types in a parent package specification. + -- In the private part, complete one type with a discriminant without + -- default (indefinite) and the other with a default discriminant + -- (definite). Declare objects of both indefinite and definite subtypes + -- in children (private and public) with initialization expressions. The + -- test verifies all values of the objects. It also verifies that + -- Constraint_Error is raised if an attempt is made to change the + -- discriminants of the objects of the indefinite subtypes. + -- + -- + -- CHANGE HISTORY: + -- 15 Jan 95 SAIC Initial version for ACVC 2.1 + -- 25 Jul 96 SAIC Modified test description. Deleted use C330001_0. + -- 20 Nov 98 RLB Added Elaborate pragmas to avoid problems + -- with an unconventional, but legal, elaboration + -- order. + --! + + package C330001_0 is + + subtype Sub_Type is Integer range 1 .. 20; + + type Tag_W_Disc (D : Sub_Type) is tagged record + C1 : String (1 .. D); + end record; + + -- Indefinite type declarations. + + type FullViewDefinite_Unknown_Disc (<>) is private; + + type Indefinite_No_Disc is array (Positive range <>) of Integer; + + type Indefinite_Tag_W_Disc (D : Sub_Type) is tagged + record + C1 : Boolean := False; + end record; + + type Indefinite_New_W_Disc (ND : Sub_Type) is new + Indefinite_Tag_W_Disc (ND) with record + C2 : Integer := 9; + end record; + + type Indefinite_W_Inherit_Disc_1 is new Tag_W_Disc with + record + S : Sub_Type := 18; + end record; + + type Indefinite_W_Inherit_Disc_2 is + new Tag_W_Disc with private; + + function Indef_Func_1 return FullViewDefinite_Unknown_Disc; + + function Indef_Func_2 (P : Sub_Type) return Indefinite_W_Inherit_Disc_2; + + private + + type FullViewDefinite_Unknown_Disc (D : Sub_Type := 2) is + record + S : String (1 .. D) := "Hi"; + end record; + + type Indefinite_W_Inherit_Disc_2 is new Tag_W_Disc with + record + S : Sub_Type; + end record; + + end C330001_0; + + --==================================================================-- + + package body C330001_0 is + + function Indef_Func_1 return FullViewDefinite_Unknown_Disc is + Var_1 : FullViewDefinite_Unknown_Disc; -- No need for explicit + -- constraints, use initial + begin -- values. + return Var_1; + end Indef_Func_1; + + ------------------------------------------------------------------ + function Indef_Func_2 (P : Sub_Type) return Indefinite_W_Inherit_Disc_2 is + Var_2 : Indefinite_W_Inherit_Disc_2 := (D => 5, C1 => "Hello", S => P); + begin + return Var_2; + end Indef_Func_2; + + end C330001_0; + + --==================================================================-- + + with C330001_0; + pragma Elaborate(C330001_0); -- Insure that the functions can be called. + private + package C330001_0.C330001_1 is + + PrivateChild_Obj : Tag_W_Disc := (D => 4, C1 => "ACVC"); + + PrivateChild_Obj_01 : Indefinite_W_Inherit_Disc_1 + := Indefinite_W_Inherit_Disc_1'(PrivateChild_Obj with S => 15); + + -- Since full view of Indefinite_W_Inherit_Disc_2 is indefinite in + -- the parent package, Indefinite_W_Inherit_Disc_2 needs an initialization + -- expression. + + PrivateChild_Obj_02 : Indefinite_W_Inherit_Disc_2 := Indef_Func_2 (19); + + -- Since full view of FullViewDefinite_Unknown_Disc is definite in the + -- parent package, no initialization expression needed for + -- PrivateChild_Obj_03. + + PrivateChild_Obj_03 : FullViewDefinite_Unknown_Disc; + + PrivateChild_Obj_04 : Indefinite_No_Disc := (12, 15); + + end C330001_0.C330001_1; + + --==================================================================-- + + with C330001_0; + pragma Elaborate(C330001_0); -- Insure that the functions can be called. + package C330001_0.C330001_2 is + + PublicChild_Obj_01 : FullViewDefinite_Unknown_Disc := Indef_Func_1; + + PublicChild_Obj_02 : Indefinite_W_Inherit_Disc_2 := Indef_Func_2 (4); + + PublicChild_Obj_03 : Indefinite_No_Disc := (38, 72, 21, 59); + + PublicChild_Obj_04 : Indefinite_Tag_W_Disc := (D => 7, C1 => True); + + PublicChild_Obj_05 : Indefinite_Tag_W_Disc := PublicChild_Obj_04; + + PublicChild_Obj_06 : Indefinite_New_W_Disc (6); + + procedure Assign_Private_Obj_3; + + function Raised_CE_PublicChild_Obj return Boolean; + + function Raised_CE_PrivateChild_Obj return Boolean; + + -- The following functions check the private types defined in the parent + -- and the private child package from within the client program. + + function Verify_Public_Obj_1 return Boolean; + + function Verify_Public_Obj_2 return Boolean; + + function Verify_Private_Obj_1 return Boolean; + + function Verify_Private_Obj_2 return Boolean; + + function Verify_Private_Obj_3 return Boolean; + + end C330001_0.C330001_2; + + --==================================================================-- + + with Report; + with C330001_0.C330001_1; + package body C330001_0.C330001_2 is + + procedure Assign_Private_Obj_3 is + begin + C330001_0.C330001_1.PrivateChild_Obj_03 := (5, "Aloha"); + end Assign_Private_Obj_3; + + ------------------------------------------------------------------ + function Raised_CE_PublicChild_Obj return Boolean is + begin + PublicChild_Obj_03 := (16, 13); -- C_E, can't change constraints + -- of PublicChild_Obj_03. + + Report.Failed ("Constraint_Error not raised - Public child"); + + -- Next line prevents dead assignment. + + Report.Comment ("PublicChild_Obj_03'First is" & Integer'Image + (PublicChild_Obj_03'First) ); + return False; + + exception + when Constraint_Error => + return True; -- Exception is expected. + when others => + return False; + end Raised_CE_PublicChild_Obj; + + ------------------------------------------------------------------ + function Raised_CE_PrivateChild_Obj return Boolean is + begin + C330001_0.C330001_1.PrivateChild_Obj_04 := (21, 87, 18); + -- C_E, can't change constraints + -- of PrivateChild_Obj_04. + + Report.Failed ("Constraint_Error not raised - Private child"); + + -- Next line prevents dead assignment. + + Report.Comment ("PrivateChild_Obj_04'Last is" & Integer'Image + (C330001_0.C330001_1.PrivateChild_Obj_04'Last) ); + return False; + + exception + when Constraint_Error => + return True; -- Exception is expected. + when others => + return False; + end Raised_CE_PrivateChild_Obj; + + ------------------------------------------------------------------ + function Verify_Public_Obj_1 return Boolean is + begin + return (PublicChild_Obj_01.D = 2 and PublicChild_Obj_01.S = "Hi"); + + end Verify_Public_Obj_1; + + ------------------------------------------------------------------ + function Verify_Public_Obj_2 return Boolean is + begin + return (PublicChild_Obj_02.D = 5 and + PublicChild_Obj_02.C1 = "Hello" and + PublicChild_Obj_02.S = 4); + + end Verify_Public_Obj_2; + + ------------------------------------------------------------------ + function Verify_Private_Obj_1 return Boolean is + begin + return (C330001_0.C330001_1.PrivateChild_Obj_01.D = 4 and + C330001_0.C330001_1.PrivateChild_Obj_01.C1 = "ACVC" and + C330001_0.C330001_1.PrivateChild_Obj_01.S = 15); + + end Verify_Private_Obj_1; + + ------------------------------------------------------------------ + function Verify_Private_Obj_2 return Boolean is + begin + return (C330001_0.C330001_1.PrivateChild_Obj_02.D = 5 and + C330001_0.C330001_1.PrivateChild_Obj_02.C1 = "Hello" and + C330001_0.C330001_1.PrivateChild_Obj_02.S = 19); + + end Verify_Private_Obj_2; + + ------------------------------------------------------------------ + function Verify_Private_Obj_3 return Boolean is + begin + return (C330001_0.C330001_1.PrivateChild_Obj_03.D = 5 and + C330001_0.C330001_1.PrivateChild_Obj_03.S = "Aloha"); + + end Verify_Private_Obj_3; + + end C330001_0.C330001_2; + + --==================================================================-- + + with C330001_0.C330001_2; + with Report; + + use C330001_0.C330001_2; + + procedure C330001 is + begin + Report.Test ("C330001", "Check that a variable object of an indefinite " & + "type is properly initialized/constrained by an initial " & + "value assignment that is a) an aggregate, b) a function, " & + "or c) an object. Check that objects of the above types " & + "do not need explicit constraints if they have initial " & + "values"); + + -- Verify values of public child objects. + + if not (Verify_Public_Obj_1 and Verify_Public_Obj_2) then + Report.Failed ("Wrong values for PublicChild_Obj_01 or " & + "PublicChild_Obj_02"); + end if; + + if PublicChild_Obj_03'First /= 1 or + PublicChild_Obj_03'Last /= 4 then + Report.Failed ("Wrong values for PublicChild_Obj_03"); + end if; + + if PublicChild_Obj_05.D /= 7 or + not PublicChild_Obj_05.C1 then + Report.Failed ("Wrong values for PublicChild_Obj_05"); + end if; + + if PublicChild_Obj_06.ND /= 6 or + PublicChild_Obj_06.C2 /= 9 or + PublicChild_Obj_06.C1 then + Report.Failed ("Wrong values for PublicChild_Obj_06"); + end if; + + -- Definite object can have its discriminant changed by assignment to + -- the entire object. + + Assign_Private_Obj_3; + + -- Verify values of private child objects. + + if not Verify_Private_Obj_1 or not + Verify_Private_Obj_2 or not + Verify_Private_Obj_3 then + Report.Failed ("Wrong values for PrivateChild_Obj_01 or " & + "PrivateChild_Obj_02 or PrivateChild_Obj_03"); + end if; + + -- Attempt to change the discriminants of the objects of the indefinite + -- subtypes: Constraint_Error. + + if not Raised_CE_PublicChild_Obj or not Raised_CE_PrivateChild_Obj then + Report.Failed ("Constraint_Error not raised"); + end if; + + Report.Result; + + end C330001; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c330002.a gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c330002.a *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c330002.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c330002.a 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,326 ---- + -- C330002.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 if a subtype indication of a variable object defines an + -- indefinite subtype, then there is an initialization expression. + -- Check that the object remains so constrained throughout its lifetime. + -- Check for cases of tagged record, arrays and generic formal type. + -- + -- TEST DESCRIPTION: + -- An indefinite subtype is either: + -- a) An unconstrained array subtype. + -- b) A subtype with unknown discriminants (this includes class-wide + -- types). + -- c) A subtype with unconstrained discriminants without defaults. + -- + -- Declare tagged types with unconstrained discriminants without + -- defaults. Declare an unconstrained array. Declare a generic formal + -- type with an unknown discriminant and a formal object of this type. + -- In the generic package, declare an object of the formal type using + -- the formal object as its initial value. In the main program, + -- declare objects of tagged types. Instantiate the generic package. + -- The test checks that Constraint_Error is raised if an attempt is + -- made to change bounds as well as discriminants of the objects of the + -- indefinite subtypes. + -- + -- + -- CHANGE HISTORY: + -- 01 Nov 95 SAIC Initial prerelease version. + -- 27 Jul 96 SAIC Modified test description & Report.Test. Added + -- code to prevent dead variable optimization. + -- + --! + + package C330002_0 is + + subtype Small_Num is Integer range 1 .. 20; + + -- Types with unconstrained discriminants without defaults. + + type Tag_Type (Disc : Small_Num) is tagged + record + S : String (1 .. Disc); + end record; + + function Tag_Value return Tag_Type; + + procedure Assign_Tag (A : out Tag_Type); + + procedure Avoid_Optimization_and_Fail (P : Tag_Type; Msg : String); + + --------------------------------------------------------------------- + -- An unconstrained array type. + + type Array_Type is array (Positive range <>) of Integer; + + function Array_Value return Array_Type; + + procedure Assign_Array (A : out Array_Type); + + --------------------------------------------------------------------- + generic + -- Type with an unknown discriminant. + type Formal_Type (<>) is private; + FT_Obj : Formal_Type; + package Gen is + Gen_Obj : Formal_Type := FT_Obj; + end Gen; + + end C330002_0; + + --==================================================================-- + + with Report; + package body C330002_0 is + + procedure Assign_Tag (A : out Tag_Type) is + begin + A := (3, "Bye"); + end Assign_Tag; + + ---------------------------------------------------------------------- + procedure Avoid_Optimization_and_Fail (P : Tag_Type; Msg : String) is + Default : Tag_Type := (1, "!"); -- Unique value. + begin + if P = Default then -- Both If branches can't do the same thing. + Report.Failed (Msg & ": Constraint_Error not raised"); + else -- Subtests should always select this path. + Report.Failed ("Constraint_Error not raised " & Msg); + end if; + end Avoid_Optimization_and_Fail; + + ---------------------------------------------------------------------- + function Tag_Value return Tag_Type is + TO : Tag_Type := (4 , "ACVC"); + begin + return TO; + end Tag_Value; + + ---------------------------------------------------------------------- + function Array_Value return Array_Type is + IA : Array_Type := (20, 31); + begin + return IA; + end Array_Value; + + ---------------------------------------------------------------------- + procedure Assign_Array (A : out Array_Type) is + begin + A := (84, 36); + end Assign_Array; + + end C330002_0; + + --==================================================================-- + + with Report; + with C330002_0; + use C330002_0; + + procedure C330002 is + + begin + Report.Test ("C330002", "Check that if a subtype indication of a " & + "variable object defines an indefinite subtype, then " & + "there is an initialization expression. Check that " & + "the object remains so constrained throughout its " & + "lifetime. Check that Constraint_Error is raised " & + "if an attempt is made to change bounds as well as " & + "discriminants of the objects of the indefinite " & + "subtypes. Check for cases of tagged record and generic " & + "formal types"); + + TagObj_Block: + declare + TObj_ByAgg : Tag_Type := (5, "Hello"); -- Initial assignment is + -- aggregate. + TObj_ByObj : Tag_Type := TObj_ByAgg; -- Initial assignment is + -- an object. + TObj_ByFunc : Tag_Type := Tag_Value; -- Initial assignment is + -- function return value. + Ren_Obj : Tag_Type renames TObj_ByAgg; + + begin + + begin + if (TObj_ByAgg.Disc /= 5) or (TObj_ByAgg.S /= "Hello") then + Report.Failed ("Wrong initial values for TObj_ByAgg"); + end if; + + TObj_ByAgg := (2, "Hi"); -- C_E, can't change the + -- value of the discriminant. + + Avoid_Optimization_and_Fail (TObj_ByAgg, "Subtest 1"); + + exception + when Constraint_Error => null; -- Exception is expected. + when others => + Report.Failed ("Unexpected exception - Subtest 1"); + end; + + + begin + Assign_Tag (Ren_Obj); -- C_E, can't change the + -- value of the discriminant. + + Avoid_Optimization_and_Fail (Ren_Obj, "Subtest 2"); + + exception + when Constraint_Error => null; -- Exception is expected. + when others => + Report.Failed ("Unexpected exception - Subtest 2"); + end; + + + begin + if (TObj_ByObj.Disc /= 5) or (TObj_ByObj.S /= "Hello") then + Report.Failed ("Wrong initial values for TObj_ByObj"); + end if; + + TObj_ByObj := (3, "Bye"); -- C_E, can't change the + -- value of the discriminant. + + Avoid_Optimization_and_Fail (TObj_ByObj, "Subtest 3"); + + exception + when Constraint_Error => null; -- Exception is expected. + when others => + Report.Failed ("Unexpected exception - Subtest 3"); + end; + + + begin + if (TObj_ByFunc.Disc /= 4) or (TObj_ByFunc.S /= "ACVC") then + Report.Failed ("Wrong initial values for TObj_ByFunc"); + end if; + + TObj_ByFunc := (5, "Aloha"); -- C_E, can't change the + -- value of the discriminant. + + Avoid_Optimization_and_Fail (TObj_ByFunc, "Subtest 4"); + + exception + when Constraint_Error => null; -- Exception is expected. + when others => + Report.Failed ("Unexpected exception - Subtest 4"); + end; + + end TagObj_Block; + + + ArrObj_Block: + declare + Arr_Const : constant Array_Type + := (9, 7, 6, 8); + Arr_ByAgg : Array_Type -- Initial assignment is + := (10, 11, 12); -- aggregate. + Arr_ByFunc : Array_Type -- Initial assignment is + := Array_Value; -- function return value. + Arr_ByObj : Array_Type -- Initial assignment is + := Arr_ByAgg; -- object. + + Arr_Obj : array (Positive range <>) of Integer + := (1, 2, 3, 4, 5); + begin + + begin + if (Arr_Const'First /= 1) or (Arr_Const'Last /= 4) then + Report.Failed ("Wrong bounds for Arr_Const"); + end if; + + if (Arr_ByAgg'First /= 1) or (Arr_ByAgg'Last /= 3) then + Report.Failed ("Wrong bounds for Arr_ByAgg"); + end if; + + if (Arr_ByFunc'First /= 1) or (Arr_ByFunc'Last /= 2) then + Report.Failed ("Wrong bounds for Arr_ByFunc"); + end if; + + if (Arr_ByObj'First /= 1) or (Arr_ByObj'Last /= 3) then + Report.Failed ("Wrong bounds for Arr_ByObj"); + end if; + + Assign_Array (Arr_ByObj); -- C_E, Arr_ByObj bounds are + -- 1..3. + + Report.Failed ("Constraint_Error not raised - Subtest 5"); + + exception + when Constraint_Error => null; -- Exception is expected. + when others => + Report.Failed ("Unexpected exception - Subtest 5"); + end; + + + begin + if (Arr_Obj'First /= 1) or (Arr_Obj'Last /= 5) then + Report.Failed ("Wrong bounds for Arr_Obj"); + end if; + + for I in 0 .. 5 loop + Arr_Obj (I + 1) := I + 5; -- C_E, Arr_Obj bounds are + end loop; -- 1..5. + + Report.Failed ("Constraint_Error not raised - Subtest 6"); + + exception + when Constraint_Error => null; -- Exception is expected. + when others => + Report.Failed ("Unexpected exception - Subtest 6"); + end; + + end ArrObj_Block; + + + GenericObj_Block: + declare + type Rec (Disc : Small_Num) is + record + S : Small_Num := Disc; + end record; + + Rec_Obj : Rec := (2, 2); + package IGen is new Gen (Rec, Rec_Obj); + + begin + IGen.Gen_Obj := (3, 3); -- C_E, can't change the + -- value of the discriminant. + + Report.Failed ("Constraint_Error not raised - Subtest 7"); + + -- Next line prevents dead assignment. + Report.Comment ("Disc is" & Integer'Image (IGen.Gen_Obj.Disc)); + + exception + when Constraint_Error => null; -- Exception is expected. + when others => + Report.Failed ("Unexpected exception - Subtest 7"); + + end GenericObj_Block; + + Report.Result; + + end C330002; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c332001.a gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c332001.a *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c332001.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c332001.a 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,226 ---- + -- C332001.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 the static expression given for a number declaration may be + -- of any numeric type. Check that the type of a named number is + -- universal_integer or universal_real regardless of the type of the + -- static expression that provides its value. + -- + -- TEST DESCRIPTION: + -- This test defines a large cross section of mixed type named numbers. + -- Well, obviously the named numbers don't have types (other than + -- universal_integer and universal_real) associated with them. + -- This test uses typed static values in the definition of several named + -- numbers, and then mixes the named numbers to ensure that their typed + -- origins do not interfere with the use of their values. + -- + -- + -- CHANGE HISTORY: + -- 10 OCT 95 SAIC Initial version + -- 11 APR 96 SAIC Fixed a few arithmetic errors for 2.1 + -- 24 NOV 98 RLB Removed decimal types to insure that this + -- test is applicable to all implementations. + -- + --! + + ----------------------------------------------------------------- C332001_0 + + package C332001_0 is + + type Enumeration_Type is ( Ah, Gnome, Er, Ay, Shun ); + + type Integer_Type is range 0..1023; + + type Modular_Type is mod 256; + + type Floating_Type is digits 4; + + type Fixed_Type is delta 0.125 range -10.0 .. 10.0; + + type Mod_Array is array(Modular_Type) of Floating_Type; + + type Int_Array is array(Integer_Type) of Fixed_Type; + + type Record_Type is record + Pinkie : Integer_Type; + Ring : Modular_Type; + Middle : Floating_Type; + Index : Fixed_Type; + end record; + + Mod_Array_Object : Mod_Array; + Int_Array_Object : Int_Array; + + Record_Object : Record_Type; + + -- numeric_literals + + Nothing_New_Integer : constant := 1; + Nothing_New_Real : constant := 1.0; + + -- static constants + + Integ : constant Integer_Type := 2; + Modul : constant Modular_Type := 2; + Float : constant Floating_Type := 2.0; -- bad practice, good test + Fixed : constant Fixed_Type := 2.0; + + Named_Integer : constant := Integ; -- 2 + Named_Modular : constant := Modul; -- 2 + Named_Float : constant := Float; -- 2.0 + Named_Fixed : constant := Fixed; -- 2.0 + + -- function calls + -- parenthetical expressions + + Fn_Integer : constant := Integer_Type'Min(Integ * 2, 8); -- 4 + Fn_Modular : constant := Modular_Type'Max(Modul + 2, Modular_Type'First);--4 + Fn_Float : constant := (Float ** 2); -- 4.0 + Fn_Fixed : constant := - Fixed; -- -2.0 + -- attributes + + ITF : constant := Integer_Type'First; -- 0 + MTL : constant := Modular_Type'Last; -- 255 + MTM : constant := Modular_Type'Modulus; -- 256 + ENP : constant := Enumeration_Type'Pos(Ay); -- 3 + MTP : constant := Modular_Type'Pred(Modul); -- 1 + FTS : constant := Fixed_Type'Size; -- # impdef + ITS : constant := Integer_Type'Succ(Integ); -- 3 + + -- array attributes 'First, 'Last, 'Length + + MAFirst : constant := Mod_Array_Object'First; -- 0 + IALast : constant := Int_Array_Object'Last; -- 1023 + MAL : constant := Mod_Array_Object'Length; -- 255 + IAL : constant := Int_Array_Object'Length; -- 1024 + + -- type conversions + -- + -- F\T Int Mod Flt Fix + -- Int . X O X + -- Mod O . X O + -- Flt X O . X + -- Fix O X O . + + Int2Mod : constant := Modular_Type (Integ); -- 2 + Int2Fix : constant := Fixed_Type (Integ); -- 2.0 + Mod2Flt : constant := Floating_Type (Modul); -- 2.0 + Flt2Int : constant := Integer_Type(Float); -- 2 + Flt2Fix : constant := Fixed_Type (Float); -- 2.0 + Fix2Mod : constant := Modular_Type (Fixed); -- 2 + + procedure Check_Values; + + -- TRANSITION CHECKS + -- + -- The following were illegal in Ada83; they are now legal in Ada95 + -- + + Int_Base_First : constant := Integer'Base'First; -- # impdef + Int_First : constant := Integer'First; -- # impdef + Int_Last : constant := Integer'Last; -- # impdef + Int_Val : constant := Integer'Val(17); -- 17 + + -- END OF TRANSITION CHECKS + + end C332001_0; + + -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + + with Report; + package body C332001_0 is + + procedure Assert( Truth : Boolean; Message: String ) is + begin + if not Truth then + Report.Failed("Assertion " & Message & " not true" ); + end if; + end Assert; + + procedure Check_Values is + begin + + Assert( Nothing_New_Integer * Named_Integer = Named_Modular, + "Nothing_New_Integer * Named_Integer = Named_Modular" ); -- 1*2 = 2 + Assert( Nothing_New_Real * Named_Float = Named_Fixed, + "Nothing_New_Real * Named_Float = Named_Fixed" );-- 1.0*2.0 = 2.0 + + Assert( Fn_Integer = Int2Mod + Flt2Int, + "Fn_Integer = Int2Mod + Flt2Int" ); -- 4 = 2+2 + Assert( Fn_Modular = Flt2Int * 2, + "Fn_Modular = Flt2Int * 2" ); -- 4 = 2*2 + Assert( Fn_Float = Mod2Flt ** Fix2Mod, + "Fn_Float = Mod2Flt ** Fix2Mod" ); -- 4.0 = 2.0**2 + Assert( Fn_Fixed = (- Mod2Flt), + "Fn_Fixed = (- Mod2Flt)" ); -- -2.0 = (-2.0) + + Assert( ITF = Modular_Type'First, + "ITF = Modular_Type'First" ); -- 0 = 0 + Assert( MTL < Integer_Type'Last, + "MTL < Integer_Type'Last" ); -- 255 < 1023 + Assert( MTM < Integer_Type'Last, + "MTM < Integer_Type'Last" ); -- 256 < 1023 + Assert( ENP > MTP, + "ENP > MTP" ); -- 3 > 1 + Assert( (FTS < MTL) or (FTS >= MTL), -- given FTS is impdef... + "(FTS < MTL) or (FTS >= MTL)" ); -- True + Assert( FTS > ITS, + "FTS > ITS" ); -- impdef > 3 + + Assert( MAFirst = Int_Array_Object'First, + "MAFirst = Int_Array_Object'First" ); -- 0 = 0 + Assert( IALast > MAFirst, + "IALast > MAFirst" ); -- 1023 > 0 + Assert( MAL < IAL, + "MAL < IAL" ); -- 255 < 1024 + + Assert( Mod2Flt = Flt2Fix, + "Mod2Flt = Flt2Fix" ); -- 2.0 = 2.0 + + end Check_Values; + + end C332001_0; + + ------------------------------------------------------------------- C332001 + + with Report; + with C332001_0; + procedure C332001 is + + begin -- Main test procedure. + + Report.Test ("C332001", "Check that the static expression given for a " & + "number declaration may be of any numeric type. " & + "Check that the type of the named number is " & + "universal_integer of universal_real regardless " & + "of the type of the static expression that " & + "provides its value" ); + + C332001_0.Check_Values; + + Report.Result; + + end C332001; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c340001.a gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c340001.a *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c340001.a 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c340001.a 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,470 ---- + -- C340001.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 user-defined equality operators are inherited by a + -- derived type except when the derived type is a nonlimited record + -- extension. In the latter case, ensure that the primitive + -- equality operation of the record extension compares any extended + -- components according to the predefined equality operators of the + -- component types. Also check that the parent portion of the extended + -- type is compared using the user-defined equality operation of the + -- parent type. + -- + -- TEST DESCRIPTION: + -- Declares a nonlimited tagged record and a limited tagged record + -- type, each in a separate package. A user-defined "=" operation is + -- defined for each type. Each type is extended with one new record + -- component added. + -- + -- Objects are declared for each parent and extended types and are + -- assigned values. For the limited type, modifier operations defined + -- in the package are used to assign values. + -- + -- To verify the use of the user-defined "=", values are assigned so + -- that predefined equality will return the opposite result if called. + -- Similarly, values are assigned to the extended type objects so that + -- one comparison will verify that the inherited components from the + -- parent are compared using the user-defined equality operation. + -- + -- A second comparison sets the values of the inherited components to + -- be the same so that equality based on the extended component may be + -- verified. For the nonlimited type, the test for equality should + -- fail, as the "=" defined for this type should include testing + -- equality of the extended component. For the limited type, "=" of the + -- parent should be inherited as-is, so the test for equality should + -- succeed even though the records differ in the extended component. + -- + -- A third package declares a discriminated tagged record. Equality + -- is user-defined and ignores the discriminant value. A type + -- extension is declared which also contains a discriminant. Since + -- an inherited discriminant may not be referenced other than in a + -- "new" discriminant, the type extension is also discriminated. The + -- discriminant is used as the constraint for the parent type. + -- + -- A variant part is declared in the type extension based on the new + -- discriminant. Comparisons are made to confirm that the user-defined + -- equality operator is used to compare values of the type extension. + -- Two record objects are given values so that user-defined equality + -- for the parent portion of the record succeeds, but the variant + -- parts in the type extended object differ. These objects are checked + -- to ensure that they are not equal. + -- + -- + -- CHANGE HISTORY: + -- 06 Dec 94 SAIC ACVC 2.0 + -- 19 Dec 94 SAIC Removed RM references from objective text. + -- + --! + + with Ada.Calendar; + package C340001_0 is + + type DB_Record is tagged record + Key : Natural range 1 .. 9999; + Data : String (1..10); + end record; + + function "=" (L, R : in DB_Record) return Boolean; + + type Dated_Record is new DB_Record with record + Retrieval_Time : Ada.Calendar.Time; + end record; + + end C340001_0; + + package body C340001_0 is + + function "=" (L, R : in DB_Record) return Boolean is + -- Key is ignored in determining equality of records + begin + return L.Data = R.Data; + end "="; + + end C340001_0; + + package C340001_1 is + + type List_Contents is array (1..10) of Integer; + type List is tagged limited record + Length : Natural range 0..10 := 0; + Contents : List_Contents := (others => 0); + end record; + + procedure Add_To (L : in out List; New_Value : in Integer); + procedure Remove_From (L : in out List); + + function "=" (L, R : in List) return Boolean; + + subtype Revision_Mark is Character range 'A' .. 'Z'; + type Revisable_List is new List with record + Revision : Revision_Mark := 'A'; + end record; + + procedure Revise (L : in out Revisable_List); + + end C340001_1; + + package body C340001_1 is + + -- Note: This is not a complete abstraction of a list. Exceptions + -- are not defined and boundary checks are not made. + + procedure Add_To (L : in out List; New_Value : in Integer) is + begin + L.Length := L.Length + 1; + L.Contents (L.Length) := New_Value; + end Add_To; + + procedure Remove_From (L : in out List) is + -- The list length is decremented. "Old" values are left in the + -- array. They are overwritten when a new value is added. + begin + L.Length := L.Length - 1; + end Remove_From; + + function "=" (L, R : in List) return Boolean is + -- Two lists are equal if they are the same length and + -- the component values within that length are the same. + -- Values stored past the end of the list are ignored. + begin + return L.Length = R.Length + and then L.Contents (1..L.Length) = R.Contents (1..R.Length); + end "="; + + procedure Revise (L : in out Revisable_List) is + begin + L.Revision := Character'Succ (L.Revision); + end Revise; + + end C340001_1; + + package C340001_2 is + + type Media is (Paper, Electronic); + + type Transaction (Medium : Media) is tagged record + ID : Natural range 1000 .. 9999; + end record; + + function "=" (L, R : in Transaction) return Boolean; + + type Authorization (Kind : Media) is new Transaction (Medium => Kind) + with record + case Kind is + when Paper => + Signature_On_File : Boolean; + when Electronic => + Paper_Backup : Boolean; -- to retain opposing value + end case; + end record; + + end C340001_2; + + package body C340001_2 is + + function "=" (L, R : in Transaction) return Boolean is + -- There may be electronic and paper copies of the same transaction. + -- The ID uniquely identifies a transaction. The medium (stored in + -- the discriminant) is ignored. + begin + return L.ID = R.ID; + end "="; + + end C340001_2; + + + with C340001_0; -- nonlimited tagged record declarations + with C340001_1; -- limited tagged record declarations + with C340001_2; -- tagged variant declarations + with Ada.Calendar; + with Report; + procedure C340001 is + + DB_Rec1 : C340001_0.DB_Record := (Key => 1, + Data => "aaaaaaaaaa"); + DB_Rec2 : C340001_0.DB_Record := (Key => 55, + Data => "aaaaaaaaaa"); + -- DB_Rec1 = DB_Rec2 using user-defined equality + -- DB_Rec1 /= DB_Rec2 using predefined equality + + Some_Time : Ada.Calendar.Time := + Ada.Calendar.Time_Of (Month => 9, Day => 16, Year => 1993); + + Another_Time : Ada.Calendar.Time := + Ada.Calendar.Time_Of (Month => 9, Day => 19, Year => 1993); + + Dated_Rec1 : C340001_0.Dated_Record := (Key => 2, + Data => "aaaaaaaaaa", + Retrieval_Time => Some_Time); + Dated_Rec2 : C340001_0.Dated_Record := (Key => 77, + Data => "aaaaaaaaaa", + Retrieval_Time => Some_Time); + Dated_Rec3 : C340001_0.Dated_Record := (Key => 77, + Data => "aaaaaaaaaa", + Retrieval_Time => Another_Time); + -- Dated_Rec1 = Dated_Rec2 if DB_Record."=" used for parent portion + -- Dated_Rec2 /= Dated_Rec3 if extended component is compared + -- using Ada.Calendar.Time."=" + + List1 : C340001_1.List; + List2 : C340001_1.List; + + RList1 : C340001_1.Revisable_List; + RList2 : C340001_1.Revisable_List; + RList3 : C340001_1.Revisable_List; + + Current : C340001_2.Transaction (C340001_2.Paper) := + (C340001_2.Paper, 2001); + Last : C340001_2.Transaction (C340001_2.Electronic) := + (C340001_2.Electronic, 2001); + -- Current = Last using user-defined equality + -- Current /= Last using predefined equality + + Approval1 : C340001_2.Authorization (C340001_2.Paper) + := (Kind => C340001_2.Paper, + ID => 1040, + Signature_On_File => True); + Approval2 : C340001_2.Authorization (C340001_2.Paper) + := (Kind => C340001_2.Paper, + ID => 2167, + Signature_On_File => False); + Approval3 : C340001_2.Authorization (C340001_2.Electronic) + := (Kind => C340001_2.Electronic, + ID => 2167, + Paper_Backup => False); + -- Approval1 /= Approval2 if user-defined equality extended with + -- component equality. + -- Approval2 /= Approval3 if differing variant parts checked + + -- Direct visibility to operator symbols + use type C340001_0.DB_Record; + use type C340001_0.Dated_Record; + + use type C340001_1.List; + use type C340001_1.Revisable_List; + + use type C340001_2.Transaction; + use type C340001_2.Authorization; + + begin + + Report.Test ("C340001", "Inheritance of user-defined ""="""); + + -- Approval1 /= Approval2 if user-defined equality extended with + -- component equality. + -- Approval2 /= Approval3 if differing variant parts checked + + --------------------------------------------------------------------- + -- Check that "=" and "/=" for the parent type call the user-defined + -- operation + --------------------------------------------------------------------- + + if not (DB_Rec1 = DB_Rec2) then + Report.Failed ("Nonlimited tagged record: " & + "User-defined equality did not override predefined " & + "equality"); + end if; + + if DB_Rec1 /= DB_Rec2 then + Report.Failed ("Nonlimited tagged record: " & + "User-defined equality did not override predefined " & + "inequality as well"); + end if; + + --------------------------------------------------------------------- + -- Check that "=" and "/=" for the type extension use the user-defined + -- equality operations from the parent to compare the inherited + -- components + --------------------------------------------------------------------- + + if not (Dated_Rec1 = Dated_Rec2) then + Report.Failed ("Nonlimited tagged record: " & + "User-defined equality was not used to compare " & + "components inherited from parent"); + end if; + + if Dated_Rec1 /= Dated_Rec2 then + Report.Failed ("Nonlimited tagged record: " & + "User-defined inequality was not used to compare " & + "components inherited from parent"); + end if; + + --------------------------------------------------------------------- + -- Check that equality and inequality for the type extension incorporate + -- the predefined equality operators for the extended component type + --------------------------------------------------------------------- + if Dated_Rec2 = Dated_Rec3 then + Report.Failed ("Nonlimited tagged record: " & + "Record equality was not extended with component " & + "equality"); + end if; + + if not (Dated_Rec2 /= Dated_Rec3) then + Report.Failed ("Nonlimited tagged record: " & + "Record inequality was not extended with component " & + "equality"); + end if; + + --------------------------------------------------------------------- + C340001_1.Add_To (List1, 1); + C340001_1.Add_To (List1, 2); + C340001_1.Add_To (List1, 3); + C340001_1.Remove_From (List1); + + C340001_1.Add_To (List2, 1); + C340001_1.Add_To (List2, 2); + + -- List1 contents are (2, (1, 2, 3, 0, 0, 0, 0, 0, 0, 0)) + -- List2 contents are (2, (1, 2, 0, 0, 0, 0, 0, 0, 0, 0)) + + -- List1 = List2 using user-defined equality + -- List1 /= List2 using predefined equality + + --------------------------------------------------------------------- + -- Check that "=" and "/=" for the parent type call the user-defined + -- operation + --------------------------------------------------------------------- + if not (List1 = List2) then + Report.Failed ("Limited tagged record : " & + "User-defined equality incorrectly implemented " ); + end if; + + if List1 /= List2 then + Report.Failed ("Limited tagged record : " & + "User-defined equality incorrectly implemented " ); + end if; + + --------------------------------------------------------------------- + -- RList1 and RList2 are made equal but "different" by adding + -- a nonzero value to RList1 then removing it. Removal updates + -- the list Length only, not its contents. The two lists will be + -- equal according to the defined list abstraction, but the records + -- will contain differing component values. + + C340001_1.Add_To (RList1, 1); + C340001_1.Add_To (RList1, 2); + C340001_1.Add_To (RList1, 3); + C340001_1.Remove_From (RList1); + + C340001_1.Add_To (RList2, 1); + C340001_1.Add_To (RList2, 2); + + C340001_1.Add_To (RList3, 1); + C340001_1.Add_To (RList3, 2); + + C340001_1.Revise (RList3); + + -- RList1 contents are (2, (1, 2, 3, 0, 0, 0, 0, 0, 0, 0), 'A') + -- RList2 contents are (2, (1, 2, 0, 0, 0, 0, 0, 0, 0, 0), 'A') + -- RList3 contents are (2, (1, 2, 0, 0, 0, 0, 0, 0, 0, 0), 'B') + + -- RList1 = RList2 if List."=" inherited + -- RList2 /= RList3 if List."=" inherited and extended with Character "=" + + --------------------------------------------------------------------- + -- Check that "=" and "/=" are the user-defined operations inherited + -- from the parent type. + --------------------------------------------------------------------- + if not (RList1 = RList2) then + Report.Failed ("Limited tagged record : " & + "User-defined equality was not inherited"); + end if; + + if RList1 /= RList2 then + Report.Failed ("Limited tagged record : " & + "User-defined inequality was not inherited"); + end if; + --------------------------------------------------------------------- + -- Check that "=" and "/=" for the type extension are NOT extended + -- with the predefined equality operators for the extended component. + -- A limited type extension should inherit the parent equality operation + -- as is. + --------------------------------------------------------------------- + if not (RList2 = RList3) then + Report.Failed ("Limited tagged record : " & + "Inherited equality operation was extended with " & + "component equality"); + end if; + + if RList2 /= RList3 then + Report.Failed ("Limited tagged record : " & + "Inherited inequality operation was extended with " & + "component equality"); + end if; + + --------------------------------------------------------------------- + -- Check that "=" and "/=" for the parent type call the user-defined + -- operation + --------------------------------------------------------------------- + if not (Current = Last) then + Report.Failed ("Variant record : " & + "User-defined equality did not override predefined " & + "equality"); + end if; + + if Current /= Last then + Report.Failed ("Variant record : " & + "User-defined inequality did not override predefined " & + "inequality"); + end if; + + --------------------------------------------------------------------- + -- Check that user-defined equality was incorporated and extended + -- with equality of extended components. + --------------------------------------------------------------------- + if not (Approval1 /= Approval2) then + Report.Failed ("Variant record : " & + "Inequality was not extended with component " & + "inequality"); + end if; + + if Approval1 = Approval2 then + Report.Failed ("Variant record : " & + "Equality was not extended with component " & + "equality"); + end if; + + --------------------------------------------------------------------- + -- Check that equality and inequality for the type extension + -- succeed despite the presence of differing variant parts. + --------------------------------------------------------------------- + if Approval2 = Approval3 then + Report.Failed ("Variant record : " & + "Equality succeeded even though variant parts " & + "in type extension differ"); + end if; + + if not (Approval2 /= Approval3) then + Report.Failed ("Variant record : " & + "Inequality failed even though variant parts " & + "in type extension differ"); + end if; + + --------------------------------------------------------------------- + Report.Result; + --------------------------------------------------------------------- + + end C340001; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c34001a.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c34001a.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c34001a.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c34001a.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,186 ---- + -- C34001A.ADA + + -- 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. + --* + -- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED + -- (IMPLICITLY) FOR DERIVED ENUMERATION TYPES, EXCLUDING BOOLEAN TYPES. + + -- JRK 8/20/86 + + WITH SYSTEM; USE SYSTEM; + WITH REPORT; USE REPORT; + + PROCEDURE C34001A IS + + TYPE PARENT IS (E1, E2, E3, 'A', E4, E5, E6); + + SUBTYPE SUBPARENT IS PARENT RANGE + PARENT'VAL (IDENT_INT (PARENT'POS (E2))) .. + PARENT'VAL (IDENT_INT (PARENT'POS (E5))); + + TYPE T IS NEW SUBPARENT RANGE + PARENT'VAL (IDENT_INT (PARENT'POS (E3))) .. + PARENT'VAL (IDENT_INT (PARENT'POS (E4))); + + X : T := E3; + W : PARENT := E1; + B : BOOLEAN := FALSE; + + PROCEDURE A (X : ADDRESS) IS + BEGIN + B := IDENT_BOOL (TRUE); + END A; + + FUNCTION IDENT (X : T) RETURN T IS + BEGIN + IF EQUAL (T'POS (X), T'POS (X)) THEN + RETURN X; -- ALWAYS EXECUTED. + END IF; + RETURN T'FIRST; + END IDENT; + + BEGIN + TEST ("C34001A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " & + "ARE DECLARED (IMPLICITLY) FOR DERIVED " & + "ENUMERATION TYPES, EXCLUDING BOOLEAN TYPES"); + + X := IDENT (E4); + IF X /= E4 THEN + FAILED ("INCORRECT :="); + END IF; + + IF T'(X) /= E4 THEN + FAILED ("INCORRECT QUALIFICATION"); + END IF; + + IF T (X) /= E4 THEN + FAILED ("INCORRECT SELF CONVERSION"); + END IF; + + IF EQUAL (3, 3) THEN + W := E3; + END IF; + IF T (W) /= E3 THEN + FAILED ("INCORRECT CONVERSION FROM PARENT"); + END IF; + + IF PARENT (X) /= E4 OR PARENT (T'VAL (0)) /= E1 THEN + FAILED ("INCORRECT CONVERSION TO PARENT"); + END IF; + + IF IDENT ('A') /= 'A' THEN + FAILED ("INCORRECT 'A'"); + END IF; + + IF IDENT (E3) /= E3 OR IDENT (E4) = E1 THEN + FAILED ("INCORRECT ENUMERATION LITERAL"); + END IF; + + IF X = IDENT ('A') OR X = E1 THEN + FAILED ("INCORRECT ="); + END IF; + + IF X /= IDENT (E4) OR NOT (X /= E1) THEN + FAILED ("INCORRECT /="); + END IF; + + IF X < IDENT (E4) OR X < E1 THEN + FAILED ("INCORRECT <"); + END IF; + + IF X > IDENT (E4) OR X > E6 THEN + FAILED ("INCORRECT >"); + END IF; + + IF X <= IDENT ('A') OR X <= E1 THEN + FAILED ("INCORRECT <="); + END IF; + + IF IDENT ('A') >= X OR X >= E6 THEN + FAILED ("INCORRECT >="); + END IF; + + IF NOT (X IN T) OR E1 IN T THEN + FAILED ("INCORRECT ""IN"""); + END IF; + + IF X NOT IN T OR NOT (E1 NOT IN T) THEN + FAILED ("INCORRECT ""NOT IN"""); + END IF; + + B := FALSE; + A (X'ADDRESS); + IF NOT B THEN + FAILED ("INCORRECT 'ADDRESS"); + END IF; + + IF T'BASE'SIZE < 3 THEN + FAILED ("INCORRECT 'BASE'SIZE"); + END IF; + + IF T'FIRST /= E3 OR T'BASE'FIRST /= E1 THEN + FAILED ("INCORRECT 'FIRST"); + END IF; + + IF T'IMAGE (X) /= "E4" OR T'IMAGE (E1) /= "E1" THEN + FAILED ("INCORRECT 'IMAGE"); + END IF; + + IF T'LAST /= E4 OR T'BASE'LAST /= E6 THEN + FAILED ("INCORRECT 'LAST"); + END IF; + + IF T'POS (X) /= 4 OR T'POS (E1) /= 0 THEN + FAILED ("INCORRECT 'POS"); + END IF; + + IF T'PRED (X) /= 'A' OR T'PRED (E2) /= E1 THEN + FAILED ("INCORRECT 'PRED"); + END IF; + + IF T'SIZE < 2 THEN + FAILED ("INCORRECT TYPE'SIZE"); + END IF; + + IF X'SIZE < 2 THEN + FAILED ("INCORRECT OBJECT'SIZE"); + END IF; + + IF T'SUCC (IDENT ('A')) /= X OR T'SUCC (E1) /= E2 THEN + FAILED ("INCORRECT 'SUCC"); + END IF; + + IF T'VAL (IDENT_INT (4)) /= X OR T'VAL (0) /= E1 THEN + FAILED ("INCORRECT 'VAL"); + END IF; + + IF T'VALUE (IDENT_STR ("E4")) /= X OR T'VALUE ("E1") /= E1 THEN + FAILED ("INCORRECT 'VALUE"); + END IF; + + IF T'WIDTH /= 3 OR T'BASE'WIDTH /= 3 THEN + FAILED ("INCORRECT 'WIDTH"); + END IF; + + RESULT; + END C34001A; diff -Nrc3pad gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c34001c.ada gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c34001c.ada *** gcc-3.3.3/gcc/testsuite/ada/acats/tests/c3/c34001c.ada 1970-01-01 00:00:00.000000000 +0000 --- gcc-3.4.0/gcc/testsuite/ada/acats/tests/c3/c34001c.ada 2003-10-27 11:28:50.000000000 +0000 *************** *** 0 **** --- 1,150 ---- + -- C34001C.ADA + + -- 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. + --* + -- FOR DERIVED ENUMERATION TYPES, EXCLUDING BOOLEAN TYPES: + + -- CHECK THAT ALL VALUES OF THE PARENT (BASE) TYPE ARE PRESENT FOR THE + -- DERIVED (BASE) TYPE WHEN THE DERIVED TYPE DEFINITION IS + -- CONSTRAINED. + + -- CHECK THAT ANY CONSTRAINT IMPOSED ON THE PARENT SUBTYPE IS ALSO + -- IMPOSED ON THE DERIVED SUBTYPE. + + -- JRK 8/20/86 + + WITH REPORT; USE REPORT; + + PROCEDURE C34001C IS + + TYPE PARENT IS (E1, E2, E3, 'A', E4, E5, E6); + + TYPE T IS NEW PARENT RANGE + PARENT'VAL (IDENT_INT (PARENT'POS (E3))) .. + PARENT'VAL (IDENT_INT (PARENT'POS (E4))); + + SUBTYPE SUBPARENT IS PARENT RANGE E3 .. E4; + + TYPE S IS NEW SUBPARENT; + + X : T; + Y : S; + + BEGIN + TEST ("C34001C", "CHECK THAT ALL VALUES OF THE PARENT (BASE) " & + "TYPE ARE PRESENT FOR THE DERIVED (BASE) TYPE " & + "WHEN THE DERIVED TYPE DEFINITION IS " & + "CONSTRAINED. ALSO CHECK THAT ANY CONSTRAINT " & + "IMPOSED ON THE PARENT SUBTYPE IS ALSO IMPOSED " & + "ON THE DERIVED SUBTYPE. CHECK FOR DERIVED " & + "ENUMERATION TYPES, EXCLUDING BOOLEAN TYPES"); + + -- CHECK THAT BASE TYPE VALUES NOT IN THE SUBTYPE ARE PRESENT. + + IF T'BASE'FIRST /= E1 OR T'BASE'LAST /= E6 OR + S'BASE'FIRST /= E1 OR S'BASE'LAST /= E6 THEN + FAILED ("INCORRECT